root/gsdl/trunk/perllib/cgiactions/metadataaction.pm @ 20538

Revision 20538, 21.2 KB (checked in by davidb, 11 years ago)

further development of metadata action

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 browser.