source: main/trunk/greenstone2/perllib/cgiactions/metadataaction.pm@ 21566

Last change on this file since 21566 was 21566, checked in by mdewsnip, 14 years ago

Changed all places explicitly using "archiveinf-doc.gdb" or "archiveinf-src.gdb" to use the dbutil::get_infodb_file_path() function... you know, the one that should have been used originally? In preparation for making it possible to use something other than GDBM, and part of making the code less GDBM-specific.
File size: 21.8 KB
Line 
1###########################################################################
2#
3# metadataaction.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 2009 New Zealand Digital Library Project
9#
10# This program is free software; you can redistr te it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package metadataaction;
27
28use strict;
29
30use cgiactions::baseaction;
31
32use dbutil;
33use ghtml;
34
35
36BEGIN {
37 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/perl-5.8");
38 require XML::Rules;
39}
40
41
42@metadataaction::ISA = ('baseaction');
43
44
45
46my $action_table =
47{
48 "get-live-metadata" => { 'compulsory-args' => [ "d", "metaname" ],
49 'optional-args' => [] },
50
51 "get-metadata" => { 'compulsory-args' => [ "d", "metaname" ],
52 'optional-args' => [ "metapos" ] },
53
54 "set-live-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ],
55 'optional-args' => [ ] },
56
57 "set-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ],
58 'optional-args' => [ "metapos" ] },
59
60 "set-archives-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ],
61 'optional-args' => [ "metapos" ]
62
63 },
64
65 "set-import-metadata" => { 'compulsory-args' => [ "metaname", "metavalue" ],
66 'optional-args' => [ "d", "f", "metamode" ]
67 # metamode can be "accumulate", "override", or "unique-id"
68 },
69
70
71 "remove-live-metadata" => { 'compulsory-args' => [ "d", "metaname" ],
72 'optional-args' => [ ] },
73
74 "remove-metadata" => { 'compulsory-args' => [ "d", "metaname" ],
75 'optional-args' => [ "metapos" ] }
76};
77
78
79sub new
80{
81 my $class = shift (@_);
82 my ($gsdl_cgi,$iis6_mode) = @_;
83
84 my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
85
86 return bless $self, $class;
87}
88
89
90
91sub get_live_metadata
92{
93 my $self = shift @_;
94
95 my $username = $self->{'username'};
96 my $collect = $self->{'collect'};
97 my $gsdl_cgi = $self->{'gsdl_cgi'};
98 my $gsdlhome = $self->{'gsdlhome'};
99
100 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
101# $gsdl_cgi->checked_chdir($collect_dir);
102
103
104 # Make sure the collection isn't locked by someone else
105 $self->lock_collection($username, $collect);
106
107 # look up additional args
108
109 my $docid = $self->{'d'};
110 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
111 $gsdl_cgi->generate_error("No docid (d=...) specified.");
112 }
113
114 my $metaname = $self->{'metaname'};
115
116 my $dbkey = "$docid.$metaname";
117
118 my $collect_tail = $collect;
119 $collect_tail =~ s/^.*[\/|\\]//;
120
121 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
122 my $gdbm_db = &util::filename_cat($index_text_directory,"live-$collect_tail.gdb");
123
124 my $cmd = "gdbmget $gdbm_db $dbkey";
125
126 if (open(GIN,"$cmd |") == 0) {
127 my $mess = "Failed to get metadata key: $metaname\n";
128 $mess .= "$!\n";
129
130 $gsdl_cgi->generate_error($mess);
131 }
132
133 else {
134 my $metavalue = "";
135
136 my $line;
137 while (defined ($line=<GIN>)) {
138 $metavalue .= $line;
139 }
140 close(GIN);
141
142 chomp($metavalue);
143
144 $gsdl_cgi->generate_ok_message("$metavalue");
145 }
146}
147
148
149
150sub get_metadata
151{
152 my $self = shift @_;
153
154 my $username = $self->{'username'};
155 my $collect = $self->{'collect'};
156 my $gsdl_cgi = $self->{'gsdl_cgi'};
157 my $gsdlhome = $self->{'gsdlhome'};
158
159
160 if ($baseaction::authentication_enabled) {
161 # Ensure the user is allowed to edit this collection
162 &authenticate_user($gsdl_cgi, $username, $collect);
163 }
164
165 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
166# $gsdl_cgi->checked_chdir($collect_dir);
167
168
169 # Make sure the collection isn't locked by someone else
170 $self->lock_collection($username, $collect);
171
172 # look up additional args
173
174 my $docid = $self->{'d'};
175 my $metaname = $self->{'metaname'};
176 my $metapos = $self->{'metapos'};
177
178 my $collect_tail = $collect;
179 $collect_tail =~ s/^.*[\/\\]//;
180
181 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
182 my $gdbm_db = &util::filename_cat($index_text_directory,"$collect_tail.gdb");
183
184 my $doc_rec_string = &dbutil::read_infodb_entry("gdbm", $gdbm_db, $docid);
185 my $doc_rec = &dbutil::convert_infodb_string_to_hash($doc_rec_string);
186 foreach my $k (keys %$doc_rec) {
187 my @escaped_v = ();
188 foreach my $v (@{$doc_rec->{$k}}) {
189 my $ev = &ghtml::unescape_html($v);
190 push(@escaped_v, $ev);
191 }
192
193 $doc_rec->{$k} = \@escaped_v;
194 }
195
196 $metapos = 0 if (!defined $metapos);
197
198 my $metavalue = $doc_rec->{$metaname}->[$metapos];
199
200 $gsdl_cgi->generate_ok_message("$metavalue");
201
202}
203
204
205
206
207sub set_live_metadata
208{
209 my $self = shift @_;
210
211 my $username = $self->{'username'};
212 my $collect = $self->{'collect'};
213 my $gsdl_cgi = $self->{'gsdl_cgi'};
214 my $gsdlhome = $self->{'gsdlhome'};
215
216
217 # don't user authenticate for now
218 if ($baseaction::authentication_enabled) {
219 # Ensure the user is allowed to edit this collection
220 &authenticate_user($gsdl_cgi, $username, $collect);
221 }
222
223 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
224# $gsdl_cgi->checked_chdir($collect_dir);
225
226
227 # Make sure the collection isn't locked by someone else
228 $self->lock_collection($username, $collect);
229
230 # look up additional args
231
232 my $docid = $self->{'d'};
233 my $metaname = $self->{'metaname'};
234 my $metavalue = $self->{'metavalue'};
235
236 my $dbkey = "$docid.$metaname";
237
238 my $collect_tail = $collect;
239 $collect_tail =~ s/^.*[\/\\]//;
240
241 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
242 my $gdbm_db = &util::filename_cat($index_text_directory,"live-$collect_tail.gdb");
243
244 my $cmd = "gdbmset \"$gdbm_db\" \"$dbkey\" \"$metavalue\"";
245
246 my $status = system($cmd);
247
248 if ($status != 0) {
249 my $mess = "Failed to set metadata key: $dbkey\n";
250
251 $mess .= "PATH: $ENV{'PATH'}\n";
252 $mess .= "cmd = $cmd\n";
253 $mess .= "Exit status: $status\n";
254 $mess .= "System Error Message: $!\n";
255
256 $gsdl_cgi->generate_error($mess);
257 }
258 else {
259 $gsdl_cgi->generate_ok_message("set-live-metadata successful: Key[$metaname]=$metavalue");
260 }
261
262}
263
264
265sub set_metadata
266{
267 my $self = shift @_;
268
269 my $username = $self->{'username'};
270 my $collect = $self->{'collect'};
271 my $gsdl_cgi = $self->{'gsdl_cgi'};
272 my $gsdlhome = $self->{'gsdlhome'};
273
274
275 # don't user authenticate for now
276 if ($baseaction::authentication_enabled) {
277 # Ensure the user is allowed to edit this collection
278 &authenticate_user($gsdl_cgi, $username, $collect);
279 }
280
281 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
282# $gsdl_cgi->checked_chdir($collect_dir);
283
284
285 # Make sure the collection isn't locked by someone else
286 $self->lock_collection($username, $collect);
287
288 # look up additional args
289
290 my $docid = $self->{'d'};
291 my $metaname = $self->{'metaname'};
292 my $metapos = $self->{'metapos'};
293 my $metavalue = $self->{'metavalue'};
294
295 my $collect_tail = $collect;
296 $collect_tail =~ s/^.*[\/\\]//;
297
298 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
299 my $gdbm_db = &util::filename_cat($index_text_directory,"$collect_tail.gdb");
300
301 my $doc_rec_string = &dbutil::read_infodb_entry("gdbm", $gdbm_db, $docid);
302 my $doc_rec = &dbutil::convert_infodb_string_to_hash($doc_rec_string);
303 foreach my $k (keys %$doc_rec) {
304 my @escaped_v = ();
305 foreach my $v (@{$doc_rec->{$k}}) {
306 if ($k eq "contains") {
307 # protect quotes in ".2;".3 etc
308 $v =~ s/\"/\\\"/g;
309 push(@escaped_v, $v);
310 }
311 else {
312 my $ev = &ghtml::unescape_html($v);
313 $ev =~ s/\"/\\\"/g;
314 push(@escaped_v, $ev);
315 }
316 }
317
318 $doc_rec->{$k} = \@escaped_v;
319 }
320
321 ## print STDERR "**** metavalue = $metavalue\n";
322
323 $metavalue =~ s/\"/\\\"/g;
324
325 if (defined $metapos) {
326 $doc_rec->{$metaname}->[$metapos] = $metavalue;
327 }
328 else {
329 $doc_rec->{$metaname} = [ $metavalue ];
330 }
331
332 ## print STDERR "**** metavalue = $metavalue\n";
333
334 my $serialized_doc_rec = &dbutil::convert_infodb_hash_to_string($doc_rec);
335
336 ## print STDERR "**** ser dr\n$serialized_doc_rec\n\n\n";
337
338 my $cmd = "gdbmset \"$gdbm_db\" \"$docid\" \"$serialized_doc_rec\"";
339
340 my $status = system($cmd);
341
342 if ($status != 0) {
343 my $mess = "Failed to set metadata key: $docid\n";
344
345 $mess .= "PATH: $ENV{'PATH'}\n";
346 $mess .= "cmd = $cmd\n";
347 $mess .= "Exit status: $status\n";
348 $mess .= "System Error Message: $!\n";
349
350 $gsdl_cgi->generate_error($mess);
351 }
352 else {
353 my $mess = "set-document-metadata successful: Key[$docid]\n";
354 $mess .= " $metaname";
355 $mess .= "->[$metapos]" if (defined $metapos);
356 $mess .= " = $metavalue";
357
358 $gsdl_cgi->generate_ok_message($mess);
359 }
360
361}
362
363
364
365sub dxml_metadata
366{
367
368 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
369
370
371 my $metaname = $parser->{'parameters'}->{'metaname'};
372 my $metamode = $parser->{'parameters'}->{'metamode'};
373
374 my $name_attr = $attrHash->{'name'};
375
376 if (($name_attr eq $metaname) && ($metamode eq "override")) {
377
378 my $metavalue = $parser->{'parameters'}->{'metavalue'};
379
380 $attrHash->{'_content'} = $metavalue;
381
382 # Don't want it to wipe out any other pieces of metadata
383 $parser->{'parameters'}->{'metamode'} = "done";
384
385 }
386
387 # raw extended
388 return (':'.$tagname => $attrHash, [$tagname => $attrHash]);
389}
390
391
392sub dxml_description
393{
394
395 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
396
397 my $metamode = $parser->{'parameters'}->{'metamode'};
398
399
400 if ($metamode eq "accumulate") {
401 # tack a new metadata tag on to the end of the <Metadata>+ block
402
403 my $metaname = $parser->{'parameters'}->{'metaname'};
404 my $metavalue = $parser->{'parameters'}->{'metavalue'};
405
406
407 my $metadata_attr = { '_content' => $metavalue,
408 'name' => $metaname,
409 'mode' => "accumulate" };
410
411 my $append_metadata = [ "Metadata" => $metadata_attr ];
412
413 my $description_content = $attrHash->{'_content'};
414
415 push(@$description_content," ", $append_metadata ,"\n ");
416
417 }
418
419 # raw
420 return $tagname => $attrHash;
421}
422
423sub edit_xml_file
424{
425 my $self = shift @_;
426
427 my ($gsdl_cgi, $filename, $rules, $options) = @_;
428
429 # use XML::Rules to add it in (read in and out again)
430
431 my $parser = XML::Rules->new(rules => $rules,
432 style => 'filter' );
433
434 my $xml_in = "";
435 if (!open(MIN,"<$filename")) {
436 $gsdl_cgi->generate_error("Unable to read in $filename: $!");
437 }
438 else {
439 my $line;
440 while (defined ($line=<MIN>)) {
441 $xml_in .= $line;
442 }
443 close(MIN);
444
445
446 my $xml_out = "";
447 $parser->filter($xml_in,\$xml_out, $options);
448
449 if (!open(MOUT,">$filename")) {
450 $gsdl_cgi->generate_error("Unable to write out to $filename: $!");
451 }
452 else {
453 print MOUT $xml_out;
454 close(MOUT);
455
456 }
457 }
458}
459
460
461
462sub edit_doc_xml
463{
464 my $self = shift @_;
465
466 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metavalue, $metapos) = @_;
467
468 # use XML::Rules to add it in (read in and out again)
469
470 my @rules =
471 ( _default => 'raw extended',
472 'Metadata' => \&dxml_metadata,
473 'Description' => \&dxml_description );
474
475 my $options = { 'metaname' => $metaname,
476 'metapos' => $metapos,
477 'metavalue' => $metavalue };
478
479 $self->edit_xml_file($gsdl_cgi,$doc_xml_filename,\@rules,$options);
480}
481
482
483sub set_archives_metadata
484{
485 my $self = shift @_;
486
487 my $username = $self->{'username'};
488 my $collect = $self->{'collect'};
489 my $gsdl_cgi = $self->{'gsdl_cgi'};
490 my $gsdlhome = $self->{'gsdlhome'};
491
492
493 # don't user authenticate for now
494 if ($baseaction::authentication_enabled) {
495 # Ensure the user is allowed to edit this collection
496 $self->authenticate_user($username, $collect);
497 }
498
499 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
500# $gsdl_cgi->checked_chdir($collect_dir);
501
502 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
503
504 # Make sure the collection isn't locked by someone else
505 $self->lock_collection($username, $collect);
506
507 # look up additional args
508
509 my $docid = $self->{'d'};
510
511 my $metaname = $self->{'metaname'};
512 my $metavalue = $self->{'metavalue'};
513 my $metapos = $self->{'metapos'};
514
515 $metapos = 0 if (!defined $metapos);
516
517 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path("gdbm", "archiveinf-doc", $archive_dir);
518
519 my $doc_rec_string = &dbutil::read_infodb_entry("gdbm", $arcinfo_doc_filename, $docid);
520 my $doc_rec = &dbutil::convert_infodb_string_to_hash($doc_rec_string);
521
522 my $doc_xml_file = $doc_rec->{'doc-file'}->[0];
523
524
525 my $archives_dir = &util::filename_cat($collect_dir,$collect,"archives");
526
527 my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file);
528
529
530 $self->edit_doc_xml($gsdl_cgi,$doc_xml_filename,
531 $metaname,$metavalue,$metapos);
532
533}
534
535
536
537
538sub mxml_metadata
539{
540
541 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
542
543
544 my $metaname = $parser->{'parameters'}->{'metaname'};
545 my $metamode = $parser->{'parameters'}->{'metamode'};
546
547 my $name_attr = $attrHash->{'name'};
548
549 if (($name_attr eq $metaname) && ($metamode eq "override")) {
550
551 my $metavalue = $parser->{'parameters'}->{'metavalue'};
552
553 $attrHash->{'_content'} = $metavalue;
554
555 # Don't want it to wipe out any other pieces of metadata
556 $parser->{'parameters'}->{'metamode'} = "done";
557
558 }
559
560 # raw extended
561 return (':'.$tagname => $attrHash, [$tagname => $attrHash]);
562}
563
564
565sub mxml_description
566{
567
568 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
569
570 my $metamode = $parser->{'parameters'}->{'metamode'};
571
572
573 if ($metamode eq "accumulate") {
574 # tack a new metadata tag on to the end of the <Metadata>+ block
575
576 my $metaname = $parser->{'parameters'}->{'metaname'};
577 my $metavalue = $parser->{'parameters'}->{'metavalue'};
578
579
580 my $metadata_attr = { '_content' => $metavalue,
581 'name' => $metaname,
582 'mode' => "accumulate" };
583
584 my $append_metadata = [ "Metadata" => $metadata_attr ];
585
586 my $description_content = $attrHash->{'_content'};
587
588 push(@$description_content," ", $append_metadata ,"\n ");
589
590 }
591
592 # raw
593 return $tagname => $attrHash;
594}
595
596sub edit_metadata_xml
597{
598 my $self = shift @_;
599
600 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metavalue, $metamode) = @_;
601
602 # use XML::Rules to add it in (read in and out again)
603
604 my @rules =
605 ( _default => 'raw extended',
606 'Metadata' => \&mxml_metadata,
607 'Description' => \&mxml_description );
608
609
610 my $parser = XML::Rules->new(rules => \@rules,
611 style => 'filter' );
612
613
614 my $xml_in = "";
615 if (!open(MIN,"<$metadata_xml_filename")) {
616 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
617 }
618 else {
619 my $line;
620 while (defined ($line=<MIN>)) {
621 $xml_in .= $line;
622 }
623 close(MIN);
624
625
626 my $xml_out = "";
627 $parser->filter($xml_in,\$xml_out, { metaname => $metaname,
628 metavalue => $metavalue,
629 metamode => $metamode } );
630
631 if (!open(MOUT,">$metadata_xml_filename")) {
632 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
633 }
634 else {
635 print MOUT $xml_out;
636 close(MOUT);
637
638 }
639 }
640}
641
642
643sub set_import_metadata
644{
645 my $self = shift @_;
646
647 my $username = $self->{'username'};
648 my $collect = $self->{'collect'};
649 my $gsdl_cgi = $self->{'gsdl_cgi'};
650 my $gsdlhome = $self->{'gsdlhome'};
651
652
653 # don't user authenticate for now
654 if ($baseaction::authentication_enabled) {
655 # Ensure the user is allowed to edit this collection
656 $self->authenticate_user($username, $collect);
657 }
658
659 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
660# $gsdl_cgi->checked_chdir($collect_dir);
661
662 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
663
664
665 # Make sure the collection isn't locked by someone else
666 $self->lock_collection($username, $collect);
667
668 # look up additional args
669
670 # want either d= or f=
671 my $docid = $self->{'d'};
672 my $import_file = $self->{'f'};
673
674 if ((!defined $docid) && (!defined $import_file)) {
675 $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified.");
676 }
677
678 my $metaname = $self->{'metaname'};
679 my $metavalue = $self->{'metavalue'};
680 my $metamode = $self->{'metamode'};
681
682 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
683 # make "accumulate" the default (less destructive, as won't actually
684 # delete any existing values)
685
686 $metamode = "accumulate";
687 }
688
689 my $metadata_xml_file;
690
691 my $import_filename = undef;
692
693 if (defined $docid) {
694 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path("gdbm", "archiveinf-doc", $archive_dir);
695 my $doc_rec_string = &dbutil::read_infodb_entry("gdbm", $arcinfo_doc_filename, $docid);
696 my $doc_rec = &dbutil::convert_infodb_string_to_hash($doc_rec_string);
697
698 # This now stores the full pathname
699 $import_filename = $doc_rec->{'src-file'}->[0];
700 }
701 else {
702 $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
703 }
704
705 # figure out correct metadata.xml file
706
707 my ($import_tailname, $import_dirname)
708 = File::Basename::fileparse($import_filename);
709
710 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
711
712 $self->edit_metadata_xml($gsdl_cgi,$metadata_xml_filename,
713 $metaname,$metavalue,$metamode);
714
715}
716
717
718
719
720
721sub remove_live_metadata
722{
723 my $self = shift @_;
724
725 my $username = $self->{'username'};
726 my $collect = $self->{'collect'};
727 my $gsdl_cgi = $self->{'gsdl_cgi'};
728 my $gsdlhome = $self->{'gsdlhome'};
729
730
731 if ($baseaction::authentication_enabled) {
732 # Ensure the user is allowed to edit this collection
733 &authenticate_user($gsdl_cgi, $username, $collect);
734 }
735
736 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
737# $gsdl_cgi->checked_chdir($collect_dir);
738
739
740 # Make sure the collection isn't locked by someone else
741 $self->lock_collection($username, $collect);
742
743 # look up additional args
744
745 my $docid = $self->{'d'};
746 my $metaname = $self->{'metaname'};
747
748 my $dbkey = "$docid.$metaname";
749
750 my $collect_tail = $collect;
751 $collect_tail =~ s/^.*[\/\\]//;
752
753 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
754 my $gdbm_db = &util::filename_cat($index_text_directory,"live-$collect_tail.gdb");
755
756 my $cmd = "gdbmdel \"$gdbm_db\" \"$dbkey\"";
757
758 my $status = system($cmd);
759
760 if ($status != 0) {
761 my $mess = "Failed to set metadata key: $dbkey\n";
762
763 $mess .= "PATH: $ENV{'PATH'}\n";
764 $mess .= "cmd = $cmd\n";
765 $mess .= "Exit status: $status\n";
766 $mess .= "System Error Message: $!\n";
767
768 $gsdl_cgi->generate_error($mess);
769 }
770 else {
771 $gsdl_cgi->generate_ok_message("DB remove successful: Key[$metaname]");
772 }
773
774}
775
776
777sub remove_metadata
778{
779 my $self = shift @_;
780
781 my $username = $self->{'username'};
782 my $collect = $self->{'collect'};
783 my $gsdl_cgi = $self->{'gsdl_cgi'};
784 my $gsdlhome = $self->{'gsdlhome'};
785
786
787 # don't user authenticate for now
788 if ($baseaction::authentication_enabled) {
789 # Ensure the user is allowed to edit this collection
790 &authenticate_user($gsdl_cgi, $username, $collect);
791 }
792
793 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
794# $gsdl_cgi->checked_chdir($collect_dir);
795
796
797 # Make sure the collection isn't locked by someone else
798 $self->lock_collection($username, $collect);
799
800 # look up additional args
801
802 my $docid = $self->{'d'};
803 my $metaname = $self->{'metaname'};
804 my $metapos = $self->{'metapos'};
805
806 my $collect_tail = $collect;
807 $collect_tail =~ s/^.*[\/\\]//;
808
809 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
810 my $gdbm_db = &util::filename_cat($index_text_directory,"$collect_tail.gdb");
811
812 my $doc_rec_string = &dbutil::read_infodb_entry("gdbm", $gdbm_db, $docid);
813 my $doc_rec = &dbutil::convert_infodb_string_to_hash($doc_rec_string);
814 foreach my $k (keys %$doc_rec) {
815 my @escaped_v = ();
816 foreach my $v (@{$doc_rec->{$k}}) {
817 if ($k eq "contains") {
818 # protect quotes in ".2;".3 etc
819 $v =~ s/\"/\\\"/g;
820 push(@escaped_v, $v);
821 }
822 else {
823 my $ev = &ghtml::unescape_html($v);
824 $ev =~ s/\"/\\\"/g;
825 push(@escaped_v, $ev);
826 }
827 }
828
829 $doc_rec->{$k} = \@escaped_v;
830 }
831
832 $metapos = 0 if (!defined $metapos);
833
834 # consider check key is defined before deleting?
835
836 my $filtered_metadata = [];
837 my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}});
838
839 for (my $i=0; $i<$num_metadata_vals; $i++) {
840 my $metavalue = shift(@{$doc_rec->{$metaname}});
841
842 if ($i != $metapos) {
843 push(@$filtered_metadata,$metavalue)
844 }
845 }
846
847 $doc_rec->{$metaname} = $filtered_metadata;
848
849 my $serialized_doc_rec = &dbutil::convert_infodb_hash_to_string($doc_rec);
850
851 my $cmd = "gdbmset \"$gdbm_db\" \"$docid\" \"$serialized_doc_rec\"";
852
853 my $status = system($cmd);
854
855 if ($status != 0) {
856 my $mess = "Failed to set metadata key: $docid\n";
857
858 $mess .= "PATH: $ENV{'PATH'}\n";
859 $mess .= "cmd = $cmd\n";
860 $mess .= "Exit status: $status\n";
861 $mess .= "System Error Message: $!\n";
862
863 $gsdl_cgi->generate_error($mess);
864 }
865 else {
866 my $mess = "DB set (with item deleted) successful: Key[$docid]\n";
867 $mess .= " $metaname";
868 $mess .= "->[$metapos]" if (defined $metapos);
869
870 $gsdl_cgi->generate_ok_message($mess);
871 }
872
873}
874
875
876
877
878
879
8801;
Note: See TracBrowser for help on using the repository browser.