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

Last change on this file since 19499 was 19499, checked in by davidb, 15 years ago

Additional work on supporting Greenstone CGI-based API
File size: 17.3 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-import-metadata" => { 'compulsory-args' => [ "metaname", "metavalue" ],
60 'optional-args' => [ "d", "f", "metamode" ]
61 # metamode can be "accumulate", "override", or "unique-id"
62 },
63 "remove-live-metadata" => { 'compulsory-args' => [ "d", "metaname" ],
64 'optional-args' => [ ] },
65
66 "remove-metadata" => { 'compulsory-args' => [ "d", "metaname" ],
67 'optional-args' => [ "metapos" ] }
68};
69
70
71sub new
72{
73 my $class = shift (@_);
74 my ($gsdl_cgi,$iis6_mode) = @_;
75
76 my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
77
78 return bless $self, $class;
79}
80
81
82
83sub get_live_metadata
84{
85 my $self = shift @_;
86
87 my $username = $self->{'username'};
88 my $collect = $self->{'collect'};
89 my $gsdl_cgi = $self->{'gsdl_cgi'};
90 my $gsdlhome = $self->{'gsdlhome'};
91
92 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
93# $gsdl_cgi->checked_chdir($collect_dir);
94
95
96 # Make sure the collection isn't locked by someone else
97 $self->lock_collection($username, $collect);
98
99 # look up additional args
100
101 my $docid = $self->{'d'};
102 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
103 $gsdl_cgi->generate_error("No docid (d=...) specified.");
104 }
105
106 my $metaname = $self->{'metaname'};
107
108 my $dbkey = "$docid.$metaname";
109
110 my $collect_tail = $collect;
111 $collect_tail =~ s/^.*[\/|\\]//;
112
113 my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
114 my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb");
115
116 my $cmd = "gdbmget $gdbm_db $dbkey";
117
118 if (open(GIN,"$cmd |") == 0) {
119 my $mess = "Failed to get metadata key: $metaname\n";
120 $mess .= "$!\n";
121
122 $gsdl_cgi->generate_error($mess);
123 }
124
125 else {
126 my $metavalue = "";
127
128 my $line;
129 while (defined ($line=<GIN>)) {
130 $metavalue .= $line;
131 }
132 close(GIN);
133
134 chomp($metavalue);
135
136 $gsdl_cgi->generate_ok_message("$metavalue");
137 }
138}
139
140
141
142sub get_metadata
143{
144 my $self = shift @_;
145
146 my $username = $self->{'username'};
147 my $collect = $self->{'collect'};
148 my $gsdl_cgi = $self->{'gsdl_cgi'};
149 my $gsdlhome = $self->{'gsdlhome'};
150
151
152 if ($baseaction::authentication_enabled) {
153 # Ensure the user is allowed to edit this collection
154 &authenticate_user($gsdl_cgi, $username, $collect);
155 }
156
157 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
158# $gsdl_cgi->checked_chdir($collect_dir);
159
160
161 # Make sure the collection isn't locked by someone else
162 $self->lock_collection($username, $collect);
163
164 # look up additional args
165
166 my $docid = $self->{'d'};
167 my $metaname = $self->{'metaname'};
168 my $metapos = $self->{'metapos'};
169
170 my $collect_tail = $collect;
171 $collect_tail =~ s/^.*[\/\\]//;
172
173 my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
174 my $gdbm_db = &util::filename_cat($gdbm_directory,"$collect_tail.gdb");
175
176 my $doc_rec = GDBMUtils::gdbmRecordToHash($gdbm_db,$docid);
177 foreach my $k (keys %$doc_rec) {
178 my @escaped_v = ();
179 foreach my $v (@{$doc_rec->{$k}}) {
180 my $ev = &ghtml::unescape_html($v);
181 push(@escaped_v, $ev);
182 }
183
184 $doc_rec->{$k} = \@escaped_v;
185 }
186
187 $metapos = 0 if (!defined $metapos);
188
189 my $metavalue = $doc_rec->{$metaname}->[$metapos];
190
191 $gsdl_cgi->generate_ok_message("$metavalue");
192
193}
194
195
196
197
198sub set_live_metadata
199{
200 my $self = shift @_;
201
202 my $username = $self->{'username'};
203 my $collect = $self->{'collect'};
204 my $gsdl_cgi = $self->{'gsdl_cgi'};
205 my $gsdlhome = $self->{'gsdlhome'};
206
207
208 # don't user authenticate for now
209 if ($baseaction::authentication_enabled) {
210 # Ensure the user is allowed to edit this collection
211 &authenticate_user($gsdl_cgi, $username, $collect);
212 }
213
214 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
215# $gsdl_cgi->checked_chdir($collect_dir);
216
217
218 # Make sure the collection isn't locked by someone else
219 $self->lock_collection($username, $collect);
220
221 # look up additional args
222
223 my $docid = $self->{'d'};
224 my $metaname = $self->{'metaname'};
225 my $metavalue = $self->{'metavalue'};
226
227 my $dbkey = "$docid.$metaname";
228
229 my $collect_tail = $collect;
230 $collect_tail =~ s/^.*[\/\\]//;
231
232 my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
233 my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb");
234
235 my $cmd = "gdbmset \"$gdbm_db\" \"$dbkey\" \"$metavalue\"";
236
237 my $status = system($cmd);
238
239 if ($status != 0) {
240 my $mess = "Failed to set metadata key: $dbkey\n";
241
242 $mess .= "PATH: $ENV{'PATH'}\n";
243 $mess .= "cmd = $cmd\n";
244 $mess .= "Exit status: $status\n";
245 $mess .= "System Error Message: $!\n";
246
247 $gsdl_cgi->generate_error($mess);
248 }
249 else {
250 $gsdl_cgi->generate_ok_message("set-live-metadata successful: Key[$metaname]=$metavalue");
251 }
252
253}
254
255
256sub set_metadata
257{
258 my $self = shift @_;
259
260 my $username = $self->{'username'};
261 my $collect = $self->{'collect'};
262 my $gsdl_cgi = $self->{'gsdl_cgi'};
263 my $gsdlhome = $self->{'gsdlhome'};
264
265
266 # don't user authenticate for now
267 if ($baseaction::authentication_enabled) {
268 # Ensure the user is allowed to edit this collection
269 &authenticate_user($gsdl_cgi, $username, $collect);
270 }
271
272 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
273# $gsdl_cgi->checked_chdir($collect_dir);
274
275
276 # Make sure the collection isn't locked by someone else
277 $self->lock_collection($username, $collect);
278
279 # look up additional args
280
281 my $docid = $self->{'d'};
282 my $metaname = $self->{'metaname'};
283 my $metapos = $self->{'metapos'};
284 my $metavalue = $self->{'metavalue'};
285
286 my $collect_tail = $collect;
287 $collect_tail =~ s/^.*[\/\\]//;
288
289 my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
290 my $gdbm_db = &util::filename_cat($gdbm_directory,"$collect_tail.gdb");
291
292 my $doc_rec = GDBMUtils::gdbmRecordToHash($gdbm_db,$docid);
293 foreach my $k (keys %$doc_rec) {
294 my @escaped_v = ();
295 foreach my $v (@{$doc_rec->{$k}}) {
296 if ($k eq "contains") {
297 # protect quotes in ".2;".3 etc
298 $v =~ s/\"/\\\"/g;
299 push(@escaped_v, $v);
300 }
301 else {
302 my $ev = &ghtml::unescape_html($v);
303 $ev =~ s/\"/\\\"/g;
304 push(@escaped_v, $ev);
305 }
306 }
307
308 $doc_rec->{$k} = \@escaped_v;
309 }
310
311 ## print STDERR "**** metavalue = $metavalue\n";
312
313 $metavalue =~ s/\"/\\\"/g;
314
315 if (defined $metapos) {
316 $doc_rec->{$metaname}->[$metapos] = $metavalue;
317 }
318 else {
319 $doc_rec->{$metaname} = [ $metavalue ];
320 }
321
322 ## print STDERR "**** metavalue = $metavalue\n";
323
324 my $serialized_doc_rec = GDBMUtils::serializeHash($doc_rec);
325
326 print STDERR "**** ser dr\n$serialized_doc_rec\n\n\n";
327
328 my $cmd = "gdbmset \"$gdbm_db\" \"$docid\" \"$serialized_doc_rec\"";
329
330 my $status = system($cmd);
331
332 if ($status != 0) {
333 my $mess = "Failed to set metadata key: $docid\n";
334
335 $mess .= "PATH: $ENV{'PATH'}\n";
336 $mess .= "cmd = $cmd\n";
337 $mess .= "Exit status: $status\n";
338 $mess .= "System Error Message: $!\n";
339
340 $gsdl_cgi->generate_error($mess);
341 }
342 else {
343 my $mess = "set-document-metadata successful: Key[$docid]\n";
344 $mess .= " $metaname";
345 $mess .= "->[$metapos]" if (defined $metapos);
346 $mess .= " = $metavalue";
347
348 $gsdl_cgi->generate_ok_message($mess);
349 }
350
351}
352
353
354
355
356
357
358sub mxml_metadata
359{
360
361 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
362
363
364 my $metaname = $parser->{'parameters'}->{'metaname'};
365 my $metamode = $parser->{'parameters'}->{'metamode'};
366
367 my $name_attr = $attrHash->{'name'};
368
369 if (($name_attr eq $metaname) && ($metamode eq "override")) {
370
371 my $metavalue = $parser->{'parameters'}->{'metavalue'};
372
373 $attrHash->{'_content'} = $metavalue;
374
375 # Don't want it to wipe out any other pieces of metadata
376 $parser->{'parameters'}->{'metamode'} = "done";
377
378 }
379
380 # raw extended
381 return (':'.$tagname => $attrHash, [$tagname => $attrHash]);
382}
383
384
385sub mxml_description
386{
387
388 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
389
390 my $metamode = $parser->{'parameters'}->{'metamode'};
391
392
393 if ($metamode eq "accumulate") {
394 # tack a new metadata tag on to the end of the <Metadata>+ block
395
396 my $metaname = $parser->{'parameters'}->{'metaname'};
397 my $metavalue = $parser->{'parameters'}->{'metavalue'};
398
399
400 my $metadata_attr = { '_content' => $metavalue,
401 'name' => $metaname,
402 'mode' => "accumulate" };
403
404 my $append_metadata = [ "Metadata" => $metadata_attr ];
405
406 my $description_content = $attrHash->{'_content'};
407
408 push(@$description_content," ", $append_metadata ,"\n ");
409
410 }
411
412 # raw
413 return $tagname => $attrHash;
414}
415
416sub edit_metadata_xml
417{
418 my $self = shift @_;
419
420 my ($gsdl_cgi, $metadata_xml_filename, $file, $metaname, $metavalue, $metamode) = @_;
421
422 # use XML::Rules to add it in (read in and out again)
423
424 my @rules =
425 ( _default => 'raw extended',
426 'Metadata' => \&mxml_metadata,
427 'Description' => \&mxml_description );
428
429
430 my $parser = XML::Rules->new(rules => \@rules,
431 style => 'filter' );
432
433
434 my $xml_in = "";
435 if (!open(MIN,"<$metadata_xml_filename")) {
436 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_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, { metaname => $metaname,
448 metavalue => $metavalue,
449 metamode => $metamode } );
450
451 if (!open(MOUT,">$metadata_xml_filename")) {
452 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
453 }
454 else {
455 print MOUT $xml_out;
456 close(MOUT);
457
458 }
459 }
460
461
462
463}
464
465sub set_import_metadata
466{
467 my $self = shift @_;
468
469 my $username = $self->{'username'};
470 my $collect = $self->{'collect'};
471 my $gsdl_cgi = $self->{'gsdl_cgi'};
472 my $gsdlhome = $self->{'gsdlhome'};
473
474
475 # don't user authenticate for now
476 if ($baseaction::authentication_enabled) {
477 # Ensure the user is allowed to edit this collection
478 $self->authenticate_user($username, $collect);
479 }
480
481 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
482# $gsdl_cgi->checked_chdir($collect_dir);
483
484 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
485
486
487 # Make sure the collection isn't locked by someone else
488 $self->lock_collection($username, $collect);
489
490 # look up additional args
491
492 # want either d= or f=
493 my $docid = $self->{'d'};
494 my $import_file = $self->{'f'};
495
496 if ((!defined $docid) && (!defined $import_file)) {
497 $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified.");
498 }
499
500 my $metaname = $self->{'metaname'};
501 my $metavalue = $self->{'metavalue'};
502 my $metamode = $self->{'metamode'};
503
504 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
505 # make "accumulate" the default (less destructive, as won't actually
506 # delete any existing values)
507
508 $metamode = "accumulate";
509 }
510
511 my $metadata_xml_file;
512
513 if (defined $docid) {
514
515 my $doc_db = "archiveinf-doc.gdb";
516 my $arcinfo_doc_filename = &util::filename_cat ($archive_dir, $doc_db);
517
518 my $doc_rec = GDBMUtils::gdbmRecordToHash($arcinfo_doc_filename,$docid);
519
520 $import_file = $doc_rec->{'src-file'}->[0];
521 }
522
523
524 my $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
525
526
527 # Assuming that the metadata field is being indexed, then
528 # **** "touch" (in the Unix sense) $import_filename so we know it needs to
529 # be reindexed?
530 # (to be implemented)
531
532 # figure out correct metadata.xml file
533
534 my ($import_tailname, $import_dirname)
535 = File::Basename::fileparse($import_filename);
536
537 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
538
539 $self->edit_metadata_xml($gsdl_cgi,$metadata_xml_filename,$import_tailname,
540 $metaname,$metavalue,$metamode);
541
542}
543
544
545
546
547
548sub remove_live_metadata
549{
550 my $self = shift @_;
551
552 my $username = $self->{'username'};
553 my $collect = $self->{'collect'};
554 my $gsdl_cgi = $self->{'gsdl_cgi'};
555 my $gsdlhome = $self->{'gsdlhome'};
556
557
558 if ($baseaction::authentication_enabled) {
559 # Ensure the user is allowed to edit this collection
560 &authenticate_user($gsdl_cgi, $username, $collect);
561 }
562
563 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
564# $gsdl_cgi->checked_chdir($collect_dir);
565
566
567 # Make sure the collection isn't locked by someone else
568 $self->lock_collection($username, $collect);
569
570 # look up additional args
571
572 my $docid = $self->{'d'};
573 my $metaname = $self->{'metaname'};
574
575 my $dbkey = "$docid.$metaname";
576
577 my $collect_tail = $collect;
578 $collect_tail =~ s/^.*[\/\\]//;
579
580 my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
581 my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb");
582
583 my $cmd = "gdbmdel \"$gdbm_db\" \"$dbkey\"";
584
585 my $status = system($cmd);
586
587 if ($status != 0) {
588 my $mess = "Failed to set metadata key: $dbkey\n";
589
590 $mess .= "PATH: $ENV{'PATH'}\n";
591 $mess .= "cmd = $cmd\n";
592 $mess .= "Exit status: $status\n";
593 $mess .= "System Error Message: $!\n";
594
595 $gsdl_cgi->generate_error($mess);
596 }
597 else {
598 $gsdl_cgi->generate_ok_message("DB remove successful: Key[$metaname]");
599 }
600
601}
602
603
604sub remove_metadata
605{
606 my $self = shift @_;
607
608 my $username = $self->{'username'};
609 my $collect = $self->{'collect'};
610 my $gsdl_cgi = $self->{'gsdl_cgi'};
611 my $gsdlhome = $self->{'gsdlhome'};
612
613
614 # don't user authenticate for now
615 if ($baseaction::authentication_enabled) {
616 # Ensure the user is allowed to edit this collection
617 &authenticate_user($gsdl_cgi, $username, $collect);
618 }
619
620 my $collect_dir = &util::filename_cat($gsdlhome, "collect");
621# $gsdl_cgi->checked_chdir($collect_dir);
622
623
624 # Make sure the collection isn't locked by someone else
625 $self->lock_collection($username, $collect);
626
627 # look up additional args
628
629 my $docid = $self->{'d'};
630 my $metaname = $self->{'metaname'};
631 my $metapos = $self->{'metapos'};
632
633 my $collect_tail = $collect;
634 $collect_tail =~ s/^.*[\/\\]//;
635
636 my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
637 my $gdbm_db = &util::filename_cat($gdbm_directory,"$collect_tail.gdb");
638
639 my $doc_rec = GDBMUtils::gdbmRecordToHash($gdbm_db,$docid);
640 foreach my $k (keys %$doc_rec) {
641 my @escaped_v = ();
642 foreach my $v (@{$doc_rec->{$k}}) {
643 if ($k eq "contains") {
644 # protect quotes in ".2;".3 etc
645 $v =~ s/\"/\\\"/g;
646 push(@escaped_v, $v);
647 }
648 else {
649 my $ev = &ghtml::unescape_html($v);
650 $ev =~ s/\"/\\\"/g;
651 push(@escaped_v, $ev);
652 }
653 }
654
655 $doc_rec->{$k} = \@escaped_v;
656 }
657
658 $metapos = 0 if (!defined $metapos);
659
660 # consider check key is defined before deleting?
661
662 my $filtered_metadata = [];
663 my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}});
664
665 for (my $i=0; $i<$num_metadata_vals; $i++) {
666 my $metavalue = shift(@{$doc_rec->{$metaname}});
667
668 if ($i != $metapos) {
669 push(@$filtered_metadata,$metavalue)
670 }
671 }
672
673 $doc_rec->{$metaname} = $filtered_metadata;
674
675 my $serialized_doc_rec = GDBMUtils::serializeHash($doc_rec);
676
677 my $cmd = "gdbmset \"$gdbm_db\" \"$docid\" \"$serialized_doc_rec\"";
678
679 my $status = system($cmd);
680
681 if ($status != 0) {
682 my $mess = "Failed to set metadata key: $docid\n";
683
684 $mess .= "PATH: $ENV{'PATH'}\n";
685 $mess .= "cmd = $cmd\n";
686 $mess .= "Exit status: $status\n";
687 $mess .= "System Error Message: $!\n";
688
689 $gsdl_cgi->generate_error($mess);
690 }
691 else {
692 my $mess = "DB set (with item deleted) successful: Key[$docid]\n";
693 $mess .= " $metaname";
694 $mess .= "->[$metapos]" if (defined $metapos);
695
696 $gsdl_cgi->generate_ok_message($mess);
697 }
698
699}
700
701
702
703
704
705
7061;
Note: See TracBrowser for help on using the repository browser.