source: gsdl/trunk/perllib/cgiactions/metadataaction.pm@ 20538

Last change on this file since 20538 was 20538, checked in by davidb, 12 years ago

further development of metadata action

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