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

Last change on this file since 27295 was 27295, checked in by ak19, 11 years ago

This commit contains bugfixes for authentication within metadata-server.pl and related perl code, and is committed separately before changes in gsajaxapi.js start to make use of it. Another important change is that for adding user comments, a user need not be in the collection's group, so checking the group shouldn't be performed. The bugfixes are to get the authentication to work and are in addition to an earlier commit that corrected the name of the authentication_enable variable in baseaction.pm. The bugfixes are: users.gdb instead of users.db, metadata-server.pl needs to call gsdlCGI's encrypt_password otherwise the password check will fail because it won't match with what's in the db. Also, the calls to authenticate_user had to be through the self variable, since its a method not a function and failed to work correctly otherwise.
File size: 101.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 dbutil;
33use ghtml;
34
35use JSON;
36
37
38BEGIN {
39# unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/perl-5.8");
40 require XML::Rules;
41}
42
43@metadataaction::ISA = ('baseaction');
44
45my $action_table =
46{
47 #GET METHODS
48 "get-import-metadata" => {
49 'compulsory-args' => [ "d", "metaname" ],
50 'optional-args' => [ "metapos" ] },
51
52 "get-archives-metadata" => {
53 'compulsory-args' => [ "d", "metaname" ],
54 'optional-args' => [ "metapos" ] },
55
56 "get-index-metadata" => {
57 'compulsory-args' => [ "d", "metaname" ],
58 'optional-args' => [ "metapos" ] },
59
60 "get-metadata" => { # alias for get-index-metadata
61 'compulsory-args' => [ "d", "metaname" ],
62 'optional-args' => [ "metapos" ] },
63
64 "get-live-metadata" => {
65 'compulsory-args' => [ "d", "metaname" ],
66 'optional-args' => [ ] },
67
68 #SET METHODS
69 "set-live-metadata" => {
70 'compulsory-args' => [ "d", "metaname", "metavalue" ],
71 'optional-args' => [ ] },
72
73 "set-metadata" => { # generic set-meta function. The 'where' param can be set to any combination of index|archives|import|live. docid d is still compulsory for setting index, archives and live meta
74 'compulsory-args' => [ "metaname", "metavalue" ],
75 'optional-args' => [ "where", "metapos", "metamode", "prevmetavalue", "d", "f" ] },
76
77 "set-index-metadata" => {
78 'compulsory-args' => [ "d", "metaname", "metavalue" ],
79 'optional-args' => [ "metapos", "metamode" ] },
80
81 "set-archives-metadata" => {
82 'compulsory-args' => [ "d", "metaname", "metavalue" ],
83 'optional-args' => [ "metapos", "metamode", "prevmetavalue" ] }, # metamode can be "accumulate", "override",
84
85 "set-import-metadata" => {
86 'compulsory-args' => [ "metaname", "metavalue" ],
87 'optional-args' => [ "d", "f", "metamode", "metapos", "prevmetavalue" ] }, # metamode can be "accumulate", "override", or "unique-id". Also need to add the ability to specify a previous metadata value to overwrite (because we can't use metapos). Metapos now supported, but assumes you are working with a Simple (instead of Complex) collection
88
89 #SET METHODS (ARRAY)
90 "set-metadata-array" => {
91 'compulsory-args' => [ "where", "json" ],
92 'optional-args' => [ ],
93 'help-string' => [
94 'A simple example: metadata-server.pl?a=set-metadata-array&where=archives|index|import&c=demo&json=[{"docid":"HASHc5bce2d6d3e5b04e470ec9","metaname":"Title","metavalue":"Tralalala","metamode":"accumulate"},{"docid":"HASHbe483fa4df4e096335d1c8","metaname":"Title","metavalue":"Lala was here","metapos":0, "metamode":"override"}]',
95
96 'A more complex example: metadata-server.pl?a=set-metadata-array&where=archives|index&c=demo&json=[{"docid":"HASHc5bce2d6d3e5b04e470ec9.1","metatable":[{"metaname":"Title","metavals":["Transformers","Robots in disguise","Autobots"]}],"metamode":"override"},{"docid":"HASHbe483fa4df4e096335d1c8.2","metaname":"Title","metavalue":"Pinky was here","metamode":"accumulate"}]' ] },
97
98# The same examples rewritten for when running the metadata-server.pl script from the commandline:
99
100# the simple example: metadata-server.pl a="set-metadata-array" where="archives|index|import" c="demo" json="[{\"docid\":\"HASHc5bce2d6d3e5b04e470ec9\",\"metaname\":\"Title\",\"metavalue\":\"Tralalala\",\"metamode\":\"accumulate\"},{\"docid\":\"HASHbe483fa4df4e096335d1c8\",\"metaname\":\"Title\",\"metavalue\":\"Lala was here\",\"metapos\":0, \"metamode\":\"override\"}]",
101
102# the more complex example: metadata-server.pl a="set-metadata-array" where="archives|index" c="demo" json="[{\"docid\":\"HASHc5bce2d6d3e5b04e470ec9.1\",\"metatable\":[{\"metaname\":\"Title\",\"metavals\":[\"Transformers\",\"Robots in disguise\",\"Autobots\"]}],\"metamode\":\"override\"},{\"docid\":\"HASHbe483fa4df4e096335d1c8.2\",\"metaname\":\"Title\",\"metavalue\":\"Pinky was here\",\"metamode\":\"accumulate\"}]"
103
104 "set-archives-metadata-array" => {
105 'compulsory-args' => [ "json" ],
106 'optional-args' => [ ] },
107
108 "set-import-metadata-array" => {
109 'compulsory-args' => [ "json" ],
110 'optional-args' => [ ] },
111
112 "set-index-metadata-array" => {
113 'compulsory-args' => [ "json" ],
114 'optional-args' => [ ] },
115
116 "set-live-metadata-array" => {
117 'compulsory-args' => [ "json" ],
118 'optional-args' => [ ] },
119
120 #REMOVE METHODS
121 "remove-import-metadata" => {
122 'compulsory-args' => [ "d", "metaname", "metavalue" ], #TODO: add f argument
123 'optional-args' => [ "metapos" ] }, # only provide metapos arg for SIMPLE collections
124
125 "remove-archives-metadata" => {
126 'compulsory-args' => [ "d", "metaname" ], #TODO: add f argument
127 'optional-args' => [ "metapos", "metavalue" ] },
128
129 "remove-live-metadata" => {
130 'compulsory-args' => [ "d", "metaname" ],
131 'optional-args' => [ ] },
132
133 "remove-index-metadata" => {
134 'compulsory-args' => [ "d", "metaname" ],
135 'optional-args' => [ "metapos", "metavalue" ] },
136
137 "remove-metadata" => { # generic remove-meta function. The 'where' param can be set to any combination of index|archives|import|live. docid d is still compulsory for setting index, archives and live meta
138 'compulsory-args' => [ "d", "metaname" ],
139 'optional-args' => [ "where", "metapos", "metavalue" ] },
140
141 #INSERT METHODS
142 "insert-metadata" => {
143 'compulsory-args' => [ "d", "metaname", "metavalue" ],
144 'optional-args' => [ ] }
145};
146
147
148sub new
149{
150 my $class = shift (@_);
151 my ($gsdl_cgi,$iis6_mode) = @_;
152
153 # Treat metavalue specially. To transmit this through a GET request
154 # the Javascript side has url-encoded it, so here we need to decode
155 # it before proceeding
156
157 my $url_encoded_metavalue = $gsdl_cgi->param("metavalue");
158 my $url_decoded_metavalue = &unicode::url_decode($url_encoded_metavalue,1);
159 my $unicode_array = &unicode::utf82unicode($url_decoded_metavalue);
160
161 $url_decoded_metavalue = join("",map(chr($_),@$unicode_array));
162 $gsdl_cgi->param("metavalue",$url_decoded_metavalue);
163
164 my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
165
166 return bless $self, $class;
167}
168
169
170sub get_live_metadata
171{
172 my $self = shift @_;
173
174 my $username = $self->{'username'};
175 my $collect = $self->{'collect'};
176 my $gsdl_cgi = $self->{'gsdl_cgi'};
177 my $gsdlhome = $self->{'gsdlhome'};
178 my $infodbtype = $self->{'infodbtype'};
179
180 # live metadata gets/saves value scoped (prefixed) by the current usename
181 # so (for now) let's not bother to enforce authentication
182
183 # Obtain the collect dir
184 my $site = $self->{'site'};
185 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
186 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
187
188 # Make sure the collection isn't locked by someone else
189 $self->lock_collection($username, $collect);
190
191 # look up additional args
192 my $docid = $self->{'d'};
193 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
194 $gsdl_cgi->generate_error("No docid (d=...) specified.");
195 }
196
197 # Generate the dbkey
198 my $metaname = $self->{'metaname'};
199 my $dbkey = "$docid.$metaname";
200
201 # To people who know $collect_tail please add some comments
202 # Obtain path to the database
203 my $collect_tail = $collect;
204 $collect_tail =~ s/^.*[\/|\\]//;
205 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
206 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
207
208 # Obtain the content of the key
209 my $cmd = "gdbmget $infodb_file_path $dbkey";
210 if (open(GIN,"$cmd |") == 0) {
211 # Catch error if gdbmget failed
212 my $mess = "Failed to get metadata key: $metaname\n";
213 $mess .= "$!\n";
214
215 $gsdl_cgi->generate_error($mess);
216 }
217 else {
218 binmode(GIN,":utf8");
219 # Read everything in and concatenate them into $metavalue
220 my $metavalue = "";
221 my $line;
222 while (defined ($line=<GIN>)) {
223 $metavalue .= $line;
224 }
225 close(GIN);
226 chomp($metavalue); # Get rid off the tailing newlines
227 $gsdl_cgi->generate_ok_message("$metavalue");
228 }
229
230 # Release the lock once it is done
231 $self->unlock_collection($username, $collect);
232}
233
234# just calls the index version
235sub get_metadata
236{
237 my $self = shift @_;
238 $self->get_index_metadata(@_);
239}
240
241sub get_index_metadata
242{
243 my $self = shift @_;
244
245 my $username = $self->{'username'};
246 my $collect = $self->{'collect'};
247 my $gsdl_cgi = $self->{'gsdl_cgi'};
248 my $gsdlhome = $self->{'gsdlhome'};
249
250 # Authenticate user if it is enabled
251 if ($baseaction::authentication_enabled) {
252 # Ensure the user is allowed to edit this collection
253 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
254 }
255
256 # Obtain the collect dir
257 my $site = $self->{'site'};
258 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
259 ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
260
261 # Make sure the collection isn't locked by someone else
262 $self->lock_collection($username, $collect);
263
264 # look up additional args
265 my $docid = $self->{'d'};
266 my $metaname = $self->{'metaname'};
267 my $metapos = $self->{'metapos'};
268 my $infodbtype = $self->{'infodbtype'};
269
270 # To people who know $collect_tail please add some comments
271 # Obtain path to the database
272 my $collect_tail = $collect;
273 $collect_tail =~ s/^.*[\/\\]//;
274 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
275 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
276
277 # Read the docid entry
278 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
279
280 # Basically loop through and unescape_html the values
281 foreach my $k (keys %$doc_rec) {
282 my @escaped_v = ();
283 foreach my $v (@{$doc_rec->{$k}}) {
284 my $ev = &ghtml::unescape_html($v);
285 push(@escaped_v, $ev);
286 }
287 $doc_rec->{$k} = \@escaped_v;
288 }
289
290 # Obtain the specified metadata value
291 $metapos = 0 if (!defined $metapos);
292 my $metavalue = $doc_rec->{$metaname}->[$metapos];
293 $gsdl_cgi->generate_ok_message("$metavalue");
294
295 # Release the lock once it is done
296 $self->unlock_collection($username, $collect);
297}
298
299
300sub get_import_metadata
301{
302 my $self = shift @_;
303
304 my $username = $self->{'username'};
305 my $collect = $self->{'collect'};
306 my $gsdl_cgi = $self->{'gsdl_cgi'};
307 my $gsdlhome = $self->{'gsdlhome'};
308
309 # Authenticate user if it is enabled
310 if ($baseaction::authentication_enabled) {
311 # Ensure the user is allowed to edit this collection
312 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
313 }
314
315 # Obtain the collect dir
316 my $site = $self->{'site'};
317 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
318 ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
319
320 # Make sure the collection isn't locked by someone else
321 $self->lock_collection($username, $collect);
322
323 # look up additional args
324 my $docid = $self->{'d'};
325 my $metaname = $self->{'metaname'};
326 my $metapos = $self->{'metapos'};
327 $metapos = 0 if (!defined $metapos); # gets the first value by default since metapos defaults to 0
328
329 my $infodbtype = $self->{'infodbtype'};
330 if (!defined $docid)
331 {
332 $gsdl_cgi->generate_error("No docid (d=...) specified.\n");
333 }
334
335 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
336 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
337 my $metadata_xml_file;
338 my $import_filename = undef;
339
340
341 my $archive_dir = &util::filename_cat($collect_dir, $collect, "archives");
342 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
343 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
344
345 # This now stores the full pathname
346 $import_filename = $doc_rec->{'src-file'}->[0];
347
348 # figure out correct metadata.xml file [?]
349 # Assuming the metadata.xml file is next to the source file
350 # Note: This will not work if it is using the inherited metadata from the parent folder
351 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
352 my $metadata_xml_filename = &util::filename_cat($import_dirname, "metadata.xml");
353
354 $gsdl_cgi->generate_ok_message($self->get_metadata_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $import_tailname));
355
356 # Release the lock once it is done
357 $self->unlock_collection($username, $collect);
358}
359
360sub get_metadata_from_metadata_xml
361{
362 my $self = shift @_;
363 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $src_file) = @_;
364
365 my @rules =
366 (
367 _default => 'raw',
368 'Metadata' => \&gfmxml_metadata,
369 'FileName' => \&mxml_filename
370 );
371
372 my $parser = XML::Rules->new
373 (
374 rules => \@rules,
375 output_encoding => 'utf8'
376 );
377
378 my $xml_in = "";
379 if (!open(MIN,"<$metadata_xml_filename"))
380 {
381 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
382 }
383 else
384 {
385 # Read them in
386 my $line;
387 while (defined ($line=<MIN>)) {
388 $xml_in .= $line;
389 }
390 close(MIN);
391
392 $parser->parse($xml_in, {metaname => $metaname, metapos => $metapos, src_file => $src_file});
393
394 if(defined $parser->{'pad'}->{'metavalue'})
395 {
396 return $parser->{'pad'}->{'metavalue'};
397 }
398 else
399 {
400 return "";
401 }
402 }
403}
404
405sub gfmxml_metadata
406{
407 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
408
409 # no subsection support yet in metadata.xml
410
411 if (($parser->{'parameters'}->{'src_file'} eq $parser->{'parameters'}->{'current_file'}) && $parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
412 {
413 if (!defined $parser->{'parameters'}->{'poscount'})
414 {
415 $parser->{'parameters'}->{'poscount'} = 0;
416 }
417 else
418 {
419 $parser->{'parameters'}->{'poscount'}++;
420 }
421
422 # gets the first value by default, since metapos defaults to 0
423 if (($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
424 {
425 if($parser->{'parameters'}->{'metapos'} > 0) {
426 print STDERR "@@@@ WARNING: non-zero metapos.\n";
427 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to retrieve the import meta at".$parser->{'parameters'}->{'metapos'}.".\n";
428 }
429 $parser->{'pad'}->{'metavalue'} = $attrHash->{'_content'};
430 }
431 }
432}
433
434sub get_archives_metadata
435{
436 my $self = shift @_;
437
438 my $username = $self->{'username'};
439 my $collect = $self->{'collect'};
440 my $gsdl_cgi = $self->{'gsdl_cgi'};
441 my $gsdlhome = $self->{'gsdlhome'};
442 my $infodbtype = $self->{'infodbtype'};
443
444 # Authenticate user if it is enabled
445 if ($baseaction::authentication_enabled) {
446 # Ensure the user is allowed to edit this collection
447 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
448 }
449
450 # Obtain the collect dir
451 my $site = $self->{'site'};
452 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
453
454 my $archive_dir = &util::filename_cat($collect_dir, $collect, "archives");
455
456 # Make sure the collection isn't locked by someone else
457 $self->lock_collection($username, $collect);
458
459 # look up additional args
460 my ($docid, $docid_secnum) = ($self->{'d'} =~ m/^(.*?)(\..*)?$/);
461 $docid_secnum = "" if (!defined $docid_secnum);
462
463 my $metaname = $self->{'metaname'};
464 my $metapos = $self->{'metapos'};
465 $metapos = 0 if (!defined $metapos);
466
467 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
468 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
469
470 # This now stores the full pathname
471 my $doc_filename = $doc_rec->{'doc-file'}->[0];
472
473 $gsdl_cgi->generate_ok_message($self->get_metadata_from_archive_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, $docid_secnum));
474
475 # Release the lock once it is done
476 $self->unlock_collection($username, $collect);
477}
478
479sub get_metadata_from_archive_xml
480{
481 my $self = shift @_;
482 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metapos, $secid) = @_;
483
484 my @start_rules = ('Section' => \&dxml_start_section);
485
486 my @rules =
487 (
488 _default => 'raw',
489 'Metadata' => \&gfdxml_metadata
490 );
491
492 my $parser = XML::Rules->new
493 (
494 start_rules => \@start_rules,
495 rules => \@rules,
496 output_encoding => 'utf8'
497 );
498
499 my $xml_in = "";
500 if (!open(MIN,"<$doc_xml_filename"))
501 {
502 $gsdl_cgi->generate_error("Unable to read in $doc_xml_filename: $!");
503 }
504 else
505 {
506 # Read them in
507 my $line;
508 while (defined ($line=<MIN>)) {
509 $xml_in .= $line;
510 }
511 close(MIN);
512
513 $parser->parse($xml_in, {metaname => $metaname, metapos => $metapos, secid => $secid});
514
515 if(defined $parser->{'pad'}->{'metavalue'})
516 {
517 return $parser->{'pad'}->{'metavalue'};
518 }
519 else
520 {
521 return "";
522 }
523 }
524}
525
526sub gfdxml_metadata
527{
528 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
529
530 if(!($parser->{'parameters'}->{'secid'} eq $parser->{'parameters'}->{'curr_section_num'}))
531 {
532 return;
533 }
534
535 if ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
536 {
537 if (!defined $parser->{'parameters'}->{'poscount'})
538 {
539 $parser->{'parameters'}->{'poscount'} = 0;
540 }
541 else
542 {
543 $parser->{'parameters'}->{'poscount'}++;
544 }
545 }
546
547 if (($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
548 {
549 $parser->{'pad'}->{'metavalue'} = $attrHash->{'_content'};
550 }
551}
552
553sub _set_live_metadata
554{
555 my $self = shift @_;
556
557 my $collect = $self->{'collect'};
558 my $gsdl_cgi = $self->{'gsdl_cgi'};
559 #my $gsdlhome = $self->{'gsdlhome'};
560 my $infodbtype = $self->{'infodbtype'};
561
562 # Obtain the collect dir
563 my $site = $self->{'site'};
564 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
565 ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
566
567
568 # look up additional args
569 my $docid = $self->{'d'};
570 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
571 $gsdl_cgi->generate_error("No docid (d=...) specified."); # generates error and dies
572 }
573 my $metavalue = $self->{'metavalue'};
574
575 # Generate the dbkey
576 my $metaname = $self->{'metaname'};
577 my $dbkey = "$docid.$metaname";
578
579 # To people who know $collect_tail please add some comments
580 # Obtain path to the database
581 my $collect_tail = $collect;
582 $collect_tail =~ s/^.*[\/\\]//;
583 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
584 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
585
586 # Set the new value
587 my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
588 my $status = system($cmd);
589 if ($status != 0) {
590 # Catch error if gdbmget failed
591 my $mess = "Failed to set metadata key: $dbkey\n";
592
593 $mess .= "PATH: $ENV{'PATH'}\n";
594 $mess .= "cmd = $cmd\n";
595 $mess .= "Exit status: $status\n";
596 $mess .= "System Error Message: $!\n";
597
598 $gsdl_cgi->generate_error($mess);
599 }
600 else {
601 $gsdl_cgi->generate_ok_message("set-live-metadata successful: Key[$metaname]=$metavalue");
602 }
603
604 #return $status; # in case calling functions have any further use for this
605}
606
607sub set_live_metadata
608{
609 my $self = shift @_;
610
611 my $username = $self->{'username'};
612 my $collect = $self->{'collect'};
613 my $gsdl_cgi = $self->{'gsdl_cgi'};
614
615 if ($baseaction::authentication_enabled) {
616 # Ensure the user is allowed to edit this collection
617 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
618 }
619
620 # Make sure the collection isn't locked by someone else
621 $self->lock_collection($username, $collect);
622
623 $self->_set_live_metadata(@_);
624
625 # Release the lock once it is done
626 $self->unlock_collection($username, $collect);
627}
628
629sub set_index_metadata_entry
630{
631 my $self = shift @_;
632 my ($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode) = @_;
633
634 # To people who know $collect_tail please add some comments
635 # Obtain path to the database
636 my $collect_tail = $collect;
637 $collect_tail =~ s/^.*[\/\\]//;
638 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
639 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
640
641# print STDERR "**** infodb file path = $infodb_file_path\n";
642# print STDERR "***** infodb type = $infodbtype\n";
643
644 # Read the docid entry
645 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
646
647 # Set the metadata value
648 if (defined $metapos) {
649 # if metamode=accumulate AND metapos, warn user and then use metapos
650 if (defined $metamode && $metamode eq "accumulate") {
651 print STDERR "**** Warning: metamode is set to accumulate yet metapos is also provided for $docid\n";
652 print STDERR "**** Proceeding by using metapos\n";
653 }
654 $doc_rec->{$metaname}->[$metapos] = $metavalue;
655 }
656 elsif (defined $metamode && $metamode eq "override") {
657 $doc_rec->{$metaname} = [ $metavalue ];
658 }
659 else { # default for index was to override, but because accumulate is less destructive,
660 # and because accumulate is the default for archives and import, that's the new default for index too
661 if(defined $doc_rec->{$metaname}) {
662 push(@{$doc_rec->{$metaname}}, $metavalue); # accumulate the value for that metaname
663 } else {
664 $doc_rec->{$metaname} = [ $metavalue ];
665 }
666 }
667
668 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path,$docid,$doc_rec);
669
670 return $status;
671
672}
673
674sub _set_import_metadata
675{
676 my $self = shift @_;
677
678 my $collect = $self->{'collect'};
679 my $gsdl_cgi = $self->{'gsdl_cgi'};
680 my $infodbtype = $self->{'infodbtype'};
681# my $gsdlhome = $self->{'gsdlhome'};
682
683 # Obtain the collect and archive dir
684 my $site = $self->{'site'};
685 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
686 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
687 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
688
689 # look up additional args
690 # want either d= or f=
691 my $docid = $self->{'d'};
692 my ($docid_root,$docid_secnum);
693 if(defined $docid) {
694 ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
695 # as yet no support for setting subsection metadata in metadata.xml
696 if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
697 $gsdl_cgi->generate_message("*** No support yet for setting import metadata at subsections level.\n");
698 return;
699 }
700 }
701
702 my $import_file = $self->{'f'};
703 if ((!defined $docid) && (!defined $import_file)) {
704 $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified.");
705 }
706
707 # Get the parameters and set default mode to "accumulate"
708 my $metaname = $self->{'metaname'};
709 my $metavalue = $self->{'metavalue'};
710## $metavalue =~ s/&amp;lt;(.*?)&amp;gt;/<$1>/g;
711 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
712
713 my $metamode = $self->{'metamode'};
714 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
715 # make "accumulate" the default (less destructive, as won't actually
716 # delete any existing values)
717 $metamode = "accumulate";
718 }
719
720 # adding metapos and prevmetavalue support to import_metadata subroutines
721 my $metapos = $self->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
722 my $prevmetavalue = $self->{'prevmetavalue'};
723
724 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
725 my $metadata_xml_filename = $self->set_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid_root, $metaname, $metapos,$metavalue, $metamode,$prevmetavalue, $collect, $collect_dir); # at this point, docid_root = docid
726
727 my $mess = "set-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
728 $mess .= " $metaname";
729 $mess .= " = $metavalue";
730 $mess .= " ($metamode)\n";
731
732 $gsdl_cgi->generate_ok_message($mess);
733
734 #return $status; # in case calling functions have any further use for this
735}
736
737# the version of set_index_meta that doesn't do authentication
738sub _set_archives_metadata
739{
740 my $self = shift @_;
741
742 my $collect = $self->{'collect'};
743 my $gsdl_cgi = $self->{'gsdl_cgi'};
744 my $infodbtype = $self->{'infodbtype'};
745
746 # Obtain the collect and archive dir
747 my $site = $self->{'site'};
748 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
749 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
750
751 # look up additional args
752 my $docid = $self->{'d'};
753 my $metaname = $self->{'metaname'};
754 my $metavalue = $self->{'metavalue'};
755 my $prevmetavalue = $self->{'prevmetavalue'};
756
757 my $metapos = $self->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
758 # Don't append "|| undef", since if metapos=0 it will then be set to undef
759
760 my $metamode = $self->{'metamode'};
761 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
762 # make "accumulate" the default (less destructive, as won't actually
763 # delete any existing values)
764 $metamode = "accumulate";
765 }
766
767 my $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,$docid,
768 $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
769
770 if ($status == 0) {
771 my $mess = "set-archives-metadata successful: Key[$docid]\n";
772 $mess .= " $metaname";
773 $mess .= "->[$metapos]" if (defined $metapos);
774 $mess .= " = $metavalue";
775 $mess .= " ($metamode)\n";
776
777 $gsdl_cgi->generate_ok_message($mess);
778 }
779 else {
780 my $mess .= "Failed to set archives metadata key: $docid\n";
781 $mess .= "Exit status: $status\n";
782 if(defined $self->{'error_msg'}) {
783 $mess .= "Error Message: $self->{'error_msg'}\n";
784 } else {
785 $mess .= "System Error Message: $!\n";
786 }
787 $mess .= "-" x 20 . "\n";
788
789 $gsdl_cgi->generate_error($mess);
790 }
791
792 #return $status; # in case calling functions have any further use for this
793}
794
795
796# the version of set_index_meta that doesn't do authentication
797sub _set_index_metadata
798{
799 my $self = shift @_;
800
801 my $collect = $self->{'collect'};
802 my $gsdl_cgi = $self->{'gsdl_cgi'};
803
804 my $site = $self->{'site'};
805 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
806
807 # look up additional args
808 my $docid = $self->{'d'};
809 my $metaname = $self->{'metaname'};
810 my $metapos = $self->{'metapos'}; # undef has meaning
811 my $metavalue = $self->{'metavalue'};
812 my $infodbtype = $self->{'infodbtype'};
813 my $metamode = $self->{'metamode'};
814
815 my $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode);
816
817 if ($status != 0) {
818 # Catch error if set infodb entry failed
819 my $mess = "Failed to set metadata key: $docid\n";
820
821 $mess .= "PATH: $ENV{'PATH'}\n";
822 $mess .= "Exit status: $status\n";
823 $mess .= "System Error Message: $!\n";
824
825 $gsdl_cgi->generate_error($mess);
826 }
827 else {
828 my $mess = "set-index-metadata successful: Key[$docid]\n";
829 $mess .= " $metaname";
830 $mess .= "->[$metapos]" if (defined $metapos);
831 $mess .= " = $metavalue\n";
832
833 $gsdl_cgi->generate_ok_message($mess);
834 }
835
836 #return $status; # in case calling functions have any further use for this
837}
838
839sub set_index_metadata
840{
841 my $self = shift @_;
842
843 my $username = $self->{'username'};
844 my $collect = $self->{'collect'};
845 my $gsdl_cgi = $self->{'gsdl_cgi'};
846 #my $gsdlhome = $self->{'gsdlhome'};
847
848 if ($baseaction::authentication_enabled) {
849 # Ensure the user is allowed to edit this collection
850 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
851 }
852
853 my $site = $self->{'site'};
854 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
855
856 $gsdl_cgi->checked_chdir($collect_dir);
857
858 # Obtain the collect dir
859 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
860
861 # Make sure the collection isn't locked by someone else
862 $self->lock_collection($username, $collect);
863
864 $self->_set_index_metadata(@_);
865
866 # Release the lock once it is done
867 $self->unlock_collection($username, $collect);
868}
869
870# call this to set the metadata for a combination of dirs archives, import or index, or live
871# if none specified, defaults to index which was the original behaviour of set_metadata.
872sub set_metadata
873{
874 my $self = shift @_;
875
876 # Testing that not defining a variable, setting it to "" or to " " all return false
877 # >perl -e 'my $whichdirs=""; if($whichdirs) {print "$whichdirs\n"};'
878
879 my $where = $self->{'where'};
880 if(!$where) {
881 $self->set_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
882 return;
883 }
884
885 # authenticate and lock collection once, even if processing multiple dirs
886 my $username = $self->{'username'};
887 my $collect = $self->{'collect'};
888 my $gsdl_cgi = $self->{'gsdl_cgi'};
889
890 if ($baseaction::authentication_enabled) {
891 # Ensure the user is allowed to edit this collection
892 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
893 }
894
895 if($where =~ m/index/) {
896 my $site = $self->{'site'};
897 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
898 $gsdl_cgi->checked_chdir($collect_dir);
899 }
900
901 # Make sure the collection isn't locked by someone else
902 $self->lock_collection($username, $collect);
903
904
905 # now at last can set the metadata. $where can specify multiple
906 # $where is of the form: import|archives|index, or a subset thereof
907
908 #my @whichdirs = split('\|', $where);
909
910 # just check whether $where contains import/archives/index/live in turn, and
911 # for each case, process it accordingly
912 if($where =~ m/import/) {
913 $self->_set_import_metadata(@_);
914 }
915
916 if($where =~ m/archives/) {
917
918 # look up docID arg which is optional to set_metadata because it's optional
919 # to set_import, but which is compulsory to set_archives_metadata
920 my $docid = $self->{'d'};
921 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
922 $gsdl_cgi->generate_error("No docid (d=...) specified."); # generates error and dies
923 }
924 # we have a docid, so can set archives meta
925 $self->_set_archives_metadata(@_);
926 }
927
928 if($where =~ m/index/) {
929
930 # look up docID arg which is optional to set_metadata because it's optional
931 # to set_import, but which is compulsory to set_archives_metadata
932 my $docid = $self->{'d'};
933 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
934 $gsdl_cgi->generate_error("No docid (d=...) specified.");
935 }
936 # we have a docid, so can set index meta
937 $self->_set_index_metadata(@_);
938 }
939
940 if($where =~ m/live/) {
941 $self->_set_live_metadata(@_); # docid param, d, is compulsory, but is checked for in subroutine
942 }
943
944 # Release the lock once it is done
945 $self->unlock_collection($username, $collect);
946}
947
948sub set_metadata_array
949{
950 my $self = shift @_;
951
952 my $where = $self->{'where'};
953 if(!$where) {
954 $self->set_index_metadata_array(@_); # default behaviour is the full version of set_index_meta_array
955 return;
956 }
957
958 my $username = $self->{'username'};
959 my $collect = $self->{'collect'};
960 my $gsdl_cgi = $self->{'gsdl_cgi'};
961
962 if ($baseaction::authentication_enabled) {
963 # Ensure the user is allowed to edit this collection
964 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
965 }
966
967 # Not sure if the checked_chdir is necessary, since lock_collection also does a chdir
968 # But including the stmt during this code reorganisation to preserve as-is what used to happen
969 my $site = $self->{'site'};
970 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
971 $gsdl_cgi->checked_chdir($collect_dir);
972
973 # Make sure the collection isn't locked by someone else
974 $self->lock_collection($username, $collect);
975
976 if($where =~ m/import/) {
977 $self->_set_import_metadata_array(@_);
978 }
979 if($where =~ m/archives/) {
980 $self->_set_archives_metadata_array(@_);
981 }
982 if($where =~ m/index/) {
983 $self->_set_index_metadata_array(@_);
984 }
985 if($where =~ m/live/) {
986 $self->_set_live_metadata_array(@_);
987 }
988
989 # Release the lock once it is done
990 $self->unlock_collection($username, $collect);
991}
992
993sub _set_index_metadata_array
994{
995 my $self = shift @_;
996
997 my $collect = $self->{'collect'};
998 my $gsdl_cgi = $self->{'gsdl_cgi'};
999 my $site = $self->{'site'};
1000 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1001
1002
1003 # look up additional args
1004
1005 my $infodbtype = $self->{'infodbtype'};
1006
1007 my $json_str = $self->{'json'};
1008 my $doc_array = decode_json $json_str;
1009
1010
1011 my $global_status = 0;
1012 my $global_mess = "";
1013
1014 my @all_docids = ();
1015
1016 foreach my $doc_array_rec ( @$doc_array ) {
1017
1018 my $status = -1;
1019 my $docid = $doc_array_rec->{'docid'};
1020
1021 push(@all_docids,$docid);
1022
1023 my $metaname = $doc_array_rec->{'metaname'};
1024 if(defined $metaname) {
1025 my $metapos = $doc_array_rec->{'metapos'}; # can legitimately be undef
1026 my $metavalue = $doc_array_rec->{'metavalue'};
1027 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1028
1029 $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode);
1030 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1031 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1032
1033 foreach my $metatable_rec ( @$metatable ) { # the subarray metatable is an array of hashmaps
1034 $metaname = $metatable_rec->{'metaname'};
1035 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
1036 my $metapos = undef;
1037 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1038
1039 foreach my $metavalue ( @$metavals ) { # metavals is an array
1040 $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode); # how do we use metamode in set_meta_entry?
1041 if($metamode eq "override") { # now, having overridden the metavalue for the first,
1042 # need to accumulate subsequent metavals for this metaname, else the just-assigned
1043 # metavalue for this metaname will be lost
1044 $metamode = "accumulate";
1045 }
1046 }
1047 }
1048 }
1049
1050 if ($status != 0) {
1051 # Catch error if set infodb entry failed
1052 $global_status = $status;
1053 $global_mess .= "Failed to set metadata key: $docid\n";
1054 $global_mess .= "Exit status: $status\n";
1055 $global_mess .= "System Error Message: $!\n";
1056 $global_mess .= "-" x 20;
1057 }
1058 }
1059
1060 if ($global_status != 0) {
1061 $global_mess .= "PATH: $ENV{'PATH'}\n";
1062 $gsdl_cgi->generate_error($global_mess);
1063 }
1064 else {
1065 my $mess = "set-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1066 $gsdl_cgi->generate_ok_message($mess);
1067 }
1068}
1069
1070sub set_index_metadata_array
1071{
1072 my $self = shift @_;
1073
1074 my $username = $self->{'username'};
1075 my $collect = $self->{'collect'};
1076 my $gsdl_cgi = $self->{'gsdl_cgi'};
1077# my $gsdlhome = $self->{'gsdlhome'};
1078
1079 if ($baseaction::authentication_enabled) {
1080 # Ensure the user is allowed to edit this collection
1081 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1082 }
1083
1084 my $site = $self->{'site'};
1085 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1086
1087 $gsdl_cgi->checked_chdir($collect_dir);
1088
1089 # Obtain the collect dir
1090 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
1091
1092 # Make sure the collection isn't locked by someone else
1093 $self->lock_collection($username, $collect);
1094
1095 $self->_set_index_metadata_array(@_);
1096
1097 # Release the lock once it is done
1098 $self->unlock_collection($username, $collect);
1099}
1100
1101# experimental, newly added in and untested
1102sub _set_live_metadata_array
1103{
1104 my $self = shift @_;
1105
1106 my $collect = $self->{'collect'};
1107 my $gsdl_cgi = $self->{'gsdl_cgi'};
1108
1109 my $site = $self->{'site'};
1110 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1111
1112
1113 # look up additional args
1114 my $infodbtype = $self->{'infodbtype'};
1115 # To people who know $collect_tail please add some comments
1116 # Obtain path to the database
1117 my $collect_tail = $collect;
1118 $collect_tail =~ s/^.*[\/\\]//;
1119 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
1120 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
1121
1122
1123 my $json_str = $self->{'json'};
1124 my $doc_array = decode_json $json_str;
1125
1126
1127 my $global_status = 0;
1128 my $global_mess = "";
1129
1130 my @all_docids = ();
1131
1132
1133 foreach my $doc_array_rec ( @$doc_array ) {
1134
1135 my $status = -1;
1136 my $docid = $doc_array_rec->{'docid'};
1137
1138 push(@all_docids,$docid);
1139
1140 my $metaname = $doc_array_rec->{'metaname'};
1141 if(defined $metaname) {
1142 my $dbkey = "$docid.$metaname";
1143 my $metavalue = $doc_array_rec->{'metavalue'};
1144
1145 # Set the new value
1146 my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
1147 $status = system($cmd);
1148
1149 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1150 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1151 foreach my $metatable_rec ( @$metatable ) {
1152 $metaname = $metatable_rec->{'metaname'};
1153 my $dbkey = "$docid.$metaname";
1154
1155 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1156 foreach my $metavalue ( @$metavals ) {
1157 my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
1158 $status = system($cmd);
1159 }
1160 }
1161
1162 }
1163
1164 if ($status != 0) {
1165 # Catch error if gdbmget failed
1166 $global_status = $status;
1167 $global_mess .= "Failed to set metadata key: $docid\n"; # $dbkey
1168 $global_mess .= "Exit status: $status\n";
1169 $global_mess .= "System Error Message: $!\n";
1170 $global_mess .= "-" x 20;
1171 }
1172 }
1173
1174 if ($global_status != 0) {
1175 $global_mess .= "PATH: $ENV{'PATH'}\n";
1176 $gsdl_cgi->generate_error($global_mess);
1177 }
1178 else {
1179 my $mess = "set-live-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1180 $gsdl_cgi->generate_ok_message($mess);
1181 }
1182}
1183
1184sub set_live_metadata_array
1185{
1186 my $self = shift @_;
1187
1188 my $username = $self->{'username'};
1189 my $collect = $self->{'collect'};
1190 my $gsdl_cgi = $self->{'gsdl_cgi'};
1191
1192 if ($baseaction::authentication_enabled) {
1193 # Ensure the user is allowed to edit this collection
1194 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1195 }
1196
1197 my $site = $self->{'site'};
1198 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1199
1200 $gsdl_cgi->checked_chdir($collect_dir);
1201
1202 # Make sure the collection isn't locked by someone else
1203 $self->lock_collection($username, $collect);
1204
1205 $self->_set_live_metadata_array(@_);
1206
1207 # Release the lock once it is done
1208 $self->unlock_collection($username, $collect);
1209}
1210
1211
1212sub dxml_metadata
1213{
1214 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1215 my $metaname = $parser->{'parameters'}->{'metaname'};
1216 my $metamode = $parser->{'parameters'}->{'metamode'};
1217
1218 print STDERR "**** Processing closing </Metadata> tag\n";
1219
1220 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
1221
1222 # Find the right metadata tag and checks if we are going to
1223 # override it
1224 #
1225 # Note: This over writes the first metadata block it
1226 # encountered. If there are multiple Sections in the doc.xml, it
1227 # might not behave as you would expect
1228
1229 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
1230## print STDERR "**** checking $opt_doc_secnum <=> $curr_secnum\n";
1231## print STDERR "**** metamode = $metamode\n";
1232
1233 if ((!defined $opt_doc_secnum) || ($opt_doc_secnum eq $curr_secnum))
1234 {
1235 my $name_attr = $attrHash->{'name'};
1236 if (($name_attr eq $metaname) && ($metamode eq "override"))
1237 {
1238 if (!defined $parser->{'parameters'}->{'poscount'})
1239 {
1240 $parser->{'parameters'}->{'poscount'} = 0;
1241 }
1242 else
1243 {
1244 $parser->{'parameters'}->{'poscount'}++;
1245 }
1246
1247 if(defined $parser->{'parameters'}->{'metapos'} && $parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'})
1248 {
1249 ##print STDERR "#### got match!!\n";
1250 # Get the value and override the current value
1251 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1252 $attrHash->{'_content'} = $metavalue;
1253
1254 # Don't want it to wipe out any other pieces of metadata
1255 $parser->{'parameters'}->{'metamode'} = "done";
1256 }
1257 elsif(defined $parser->{'parameters'}->{'prevmetavalue'} && $parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'})
1258 {
1259 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1260 $attrHash->{'_content'} = $metavalue;
1261 $parser->{'parameters'}->{'metamode'} = "done";
1262 }
1263 }
1264 }
1265
1266 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1267 return [$tagname => $attrHash];
1268}
1269
1270# This method exists purely for catching invalid section numbers that the client
1271# requested to edit. Once the parser has reached the end (the final </Archive> tag),
1272# we've seen all the Sections in the doc.xml, and none of their section nums matched
1273# if the metamode has not been set to 'done' by then.
1274sub dxml_archive
1275{
1276 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1277 my $metamode = $parser->{'parameters'}->{'metamode'};
1278
1279 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
1280 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
1281
1282# print STDERR "@@@ $tagname Processing a closing </Archive> tag [$curr_secnum|$opt_doc_secnum]\n";
1283
1284 if ($metamode ne "done" && $curr_secnum ne $opt_doc_secnum) {
1285 print STDERR "@@@ $tagname Finished processing FINAL Section.\n";
1286
1287 my $metaname = $parser->{'parameters'}->{'metaname'};
1288 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1289
1290 print STDERR "@@@ Requested section number $opt_doc_secnum not found.\n";
1291 print STDERR "\t(last seen section number in document was $curr_secnum)\n";
1292 print STDERR "\tDiscarded metadata value '$metavalue' for meta '$metaname'\n";
1293 print STDERR "\tin section $opt_doc_secnum.\n";
1294 $parser->{'custom_err_msg'} = "Requested section number $opt_doc_secnum not found.";
1295 }
1296
1297 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1298 return [$tagname => $attrHash];
1299}
1300
1301sub dxml_description
1302{
1303 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1304 my $metamode = $parser->{'parameters'}->{'metamode'};
1305
1306 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
1307 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'} || "";
1308
1309 print STDERR "**** Processing a closing </Description> tag \n";
1310# print STDERR "@@@ $tagname Processing a closing </Description> tag [$curr_secnum|$opt_doc_secnum]\n";
1311
1312 # Accumulate the metadata
1313
1314 # We'll be accumulating metadata at this point if we haven't found and therefore
1315 # haven't processed the metadata yet.
1316 # For subsections, this means that if we're at a matching subsection, but haven't
1317 # found the correct metaname to override in that subsection, we accumulate it as new
1318 # meta in the subsection by adding it to the current description.
1319 # If there's no subsection info for the metadata, it will accumulate at the top level
1320 # section description if we hadn't found a matching metaname to override at this point.
1321
1322 # Both curr_secnum and opt_doc_secnum can be "". In the former case, it means we're now
1323 # at the toplevel section. In the latter case, it means we want to process meta in the
1324 # toplevel section. So the eq check between the values below will work in all cases.
1325
1326 # The only time this won't work is if an opt_doc_secnum beyond the section numbers of
1327 # this document has been provided. In that case, the metadata for that opt_doc_secnum
1328 # won't get attached/accumulated to any part of the doc, not even its top-level section.
1329
1330 if ($curr_secnum eq $opt_doc_secnum
1331 && ($metamode eq "accumulate" || $metamode eq "override")) {
1332 if ($metamode eq "override") {
1333 print "No metadata value to override. Switching 'metamode' to accumulate\n";
1334 }
1335
1336 # If we get to here and metamode is override, this means there
1337 # was no existing value to overide => treat as an append operation
1338
1339 # Tack a new metadata tag on to the end of the <Metadata>+ block
1340 my $metaname = $parser->{'parameters'}->{'metaname'};
1341 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1342
1343 my $metadata_attr = {
1344 '_content' => $metavalue,
1345 'name' => $metaname,
1346 'mode' => "accumulate"
1347 };
1348
1349 my $append_metadata = [ "Metadata" => $metadata_attr ];
1350 my $description_content = $attrHash->{'_content'};
1351
1352 print "Appending metadata to doc.xml\n";
1353
1354 if (ref($description_content)) {
1355 # got some existing interesting nested content
1356 push(@$description_content, " ", $append_metadata ,"\n ");
1357 }
1358 else {
1359 #description_content is most likely a string such as "\n"
1360 $attrHash->{'_content'} = [$description_content, " ", $append_metadata ,"\n" ];
1361 }
1362
1363 $parser->{'parameters'}->{'metamode'} = "done";
1364 }
1365 else {
1366 # metamode most likely "done" signifying that it has already found a position to add the metadata to.
1367## print STDERR "**** NOT ACCUMULATE?!? \n";
1368 }
1369
1370 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1371 return [$tagname => $attrHash];
1372}
1373
1374
1375sub dxml_start_section
1376{
1377 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1378
1379 my $new_depth = scalar(@$contextArray);
1380
1381 print STDERR "**** START SECTION \n";
1382
1383 if ($new_depth == 1) {
1384 $parser->{'parameters'}->{'curr_section_depth'} = 1;
1385 $parser->{'parameters'}->{'curr_section_num'} = "";
1386 }
1387
1388 my $old_depth = $parser->{'parameters'}->{'curr_section_depth'};
1389 my $old_secnum = $parser->{'parameters'}->{'curr_section_num'};
1390
1391 my $new_secnum;
1392
1393 if ($new_depth > $old_depth) {
1394 # child subsection
1395 $new_secnum = "$old_secnum.1";
1396 }
1397 elsif ($new_depth == $old_depth) {
1398 # sibling section => increase it's value by 1
1399 my ($tail_num) = ($old_secnum =~ m/\.(\d+)$/);
1400 $tail_num++;
1401 $new_secnum = $old_secnum;
1402 $new_secnum =~ s/\.(\d+)$/\.$tail_num/;
1403 }
1404 else {
1405 # back up to parent section => lopp off tail
1406 $new_secnum = $old_secnum;
1407 $new_secnum =~ s/\.\d+$//;
1408 }
1409
1410 $parser->{'parameters'}->{'curr_section_depth'} = $new_depth;
1411 $parser->{'parameters'}->{'curr_section_num'} = $new_secnum;
1412
1413 1;
1414}
1415
1416sub edit_xml_file
1417{
1418 my $self = shift @_;
1419 my ($gsdl_cgi, $filename, $start_rules, $rules, $options) = @_;
1420
1421 # use XML::Rules to add it in (read in and out again)
1422 my $parser = XML::Rules->new(start_rules => $start_rules,
1423 rules => $rules,
1424 style => 'filter',
1425 output_encoding => 'utf8' );
1426
1427 my $xml_in = "";
1428 if (!open(MIN,"<$filename")) {
1429 $gsdl_cgi->generate_error("Unable to read in $filename: $!");
1430 }
1431 else {
1432 # Read all the text in
1433 my $line;
1434 while (defined ($line=<MIN>)) {
1435 $xml_in .= $line;
1436 }
1437 close(MIN);
1438
1439 my $MOUT;
1440 if (!open($MOUT,">$filename")) {
1441 $gsdl_cgi->generate_error("Unable to write out to $filename: $!");
1442 }
1443 else {
1444 # Matched lines will get handled by the call backs
1445## my $xml_out = "";
1446
1447 binmode($MOUT,":utf8");
1448 $parser->filter($xml_in,$MOUT, $options);
1449
1450# binmode(MOUT,":utf8");
1451# print MOUT $xml_out;
1452 close($MOUT);
1453 }
1454 }
1455
1456 # copy across any custom error information that was stored during parsing
1457 $self->{'error_msg'} = $parser->{'custom_err_msg'} if(defined $parser->{'custom_err_msg'});
1458}
1459
1460sub edit_doc_xml
1461{
1462 my $self = shift @_;
1463 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metavalue, $metapos, $metamode, $opt_secnum, $prevmetavalue) = @_;
1464
1465 my $info_mess = <<RAWEND;
1466****************************
1467 edit_doc_xml()
1468****************************
1469doc_xml_filename = $doc_xml_filename
1470metaname = $metaname
1471metavalue = $metavalue
1472metapos = $metapos
1473metamode = $metamode
1474opt_secnum = $opt_secnum
1475prevmetavalue = $prevmetavalue
1476****************************
1477RAWEND
1478
1479 $gsdl_cgi->generate_message($info_mess);
1480
1481 # To monitor which section/subsection number we are in
1482 my @start_rules =
1483 ( 'Section' => \&dxml_start_section );
1484
1485 # use XML::Rules to add it in (read in and out again)
1486 # Set the call back functions
1487 my @rules =
1488 ( _default => 'raw',
1489 'Metadata' => \&dxml_metadata,
1490 'Description' => \&dxml_description,
1491 'Archive' => \&dxml_archive); # just for catching errors at end
1492
1493 # Sets the parameters
1494 my $options = { 'metaname' => $metaname,
1495 'metapos' => $metapos,
1496 'metavalue' => $metavalue,
1497 'metamode' => $metamode,
1498 'prevmetavalue' => $prevmetavalue };
1499
1500 if (defined $opt_secnum) {
1501 $options->{'secnum'} = $opt_secnum;
1502 }
1503
1504 $self->edit_xml_file($gsdl_cgi,$doc_xml_filename,\@start_rules,\@rules,$options);
1505}
1506
1507sub set_archives_metadata_entry
1508{
1509 my $self = shift @_;
1510 my ($gsdl_cgi, $archive_dir, $collect_dir, $collect, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue) = @_;
1511
1512 my $info_mess = <<RAWEND;
1513****************************
1514 set_archives_metadata_entry()
1515****************************
1516archive_dir = $archive_dir
1517collect_dir = $collect_dir
1518collect = $collect
1519infodbtype = $infodbtype
1520docid = $docid
1521metaname = $metaname
1522metapos = $metapos
1523metavalue = $metavalue
1524metamode = $metamode
1525prevmetavalue = $prevmetavalue
1526****************************
1527RAWEND
1528
1529 $gsdl_cgi->generate_message($info_mess);
1530
1531 # Obtain the doc.xml path for the specified docID
1532 my ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
1533
1534 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1535 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid_root);
1536 my $doc_xml_file = $doc_rec->{'doc-file'}->[0];
1537
1538 # The $doc_xml_file is relative to the archives, and now let's get the full path
1539 my $archives_dir = &util::filename_cat($collect_dir,$collect,"archives");
1540 my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file);
1541
1542 # If we're overriding everything, then $metamode=override combined with $metapos=undefined
1543 # in which case, we need to remove all metavalues for the metaname at the given (sub)section
1544 # Thereafter, we will finally be setting the overriding metavalue for this metaname
1545 if(!defined $metapos && $metamode eq "override") {
1546 $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_xml_file), $metaname, $metapos, undef, $docid_secnum, $metamode);
1547 }
1548
1549 # Edit the doc.xml file with the specified metadata name, value and position.
1550 # TODO: there is a potential problem here as this edit_doc_xml function
1551 # is assuming the simple doc.xml situation where there is only one Section and no SubSections.
1552 # Running import.pl -groupsize will cause this to have multiple sections in one doc.xml
1553
1554 # dxml_metadata method ignores metapos if metamode anything other than override
1555 $self->edit_doc_xml($gsdl_cgi,$doc_xml_filename,
1556 $metaname,$metavalue,$metapos,$metamode,$docid_secnum,$prevmetavalue);
1557
1558 # return 0; # return 0 for now to indicate no error
1559 return (defined $self->{'error_msg'}) ? 1 : 0;
1560}
1561
1562
1563sub set_archives_metadata
1564{
1565 my $self = shift @_;
1566
1567 my $username = $self->{'username'};
1568 my $collect = $self->{'collect'};
1569 my $gsdl_cgi = $self->{'gsdl_cgi'};
1570
1571 if ($baseaction::authentication_enabled) {
1572 # Ensure the user is allowed to edit this collection
1573 $self->authenticate_user($username, $collect);
1574 }
1575
1576 # Make sure the collection isn't locked by someone else
1577 $self->lock_collection($username, $collect);
1578
1579 $self->_set_archives_metadata(@_);
1580
1581 # Release the lock once it is done
1582 $self->unlock_collection($username, $collect);
1583}
1584
1585sub _set_archives_metadata_array
1586{
1587 my $self = shift @_;
1588
1589 my $collect = $self->{'collect'};
1590 my $gsdl_cgi = $self->{'gsdl_cgi'};
1591 my $site = $self->{'site'};
1592 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1593
1594 # look up additional args
1595
1596 my $infodbtype = $self->{'infodbtype'};
1597
1598 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1599
1600 my $json_str = $self->{'json'};
1601 my $doc_array = decode_json $json_str;
1602
1603
1604 my $global_status = 0;
1605 my $global_mess = "";
1606
1607 my @all_docids = ();
1608
1609 foreach my $doc_array_rec ( @$doc_array ) {
1610 my $status = -1;
1611 my $docid = $doc_array_rec->{'docid'};
1612
1613 push(@all_docids,$docid);
1614
1615 my $metaname = $doc_array_rec->{'metaname'};
1616 if(defined $metaname) {
1617
1618 my $metapos = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
1619
1620 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1621 my $metavalue = $doc_array_rec->{'metavalue'};
1622 my $prevmetavalue = $self->{'prevmetavalue'}; # to make this sub behave as _set_archives_metadata
1623
1624
1625 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1626 # make "accumulate" the default (less destructive, as it won't actually
1627 # delete any existing values)
1628 $metamode = "accumulate";
1629 }
1630
1631 $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,$docid,
1632 $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1633 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1634 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1635
1636 foreach my $metatable_rec ( @$metatable ) {
1637 $metaname = $metatable_rec->{'metaname'};
1638 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
1639 my $metapos = undef;
1640 my $prevmetavalue = undef;
1641 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1642
1643 foreach my $metavalue ( @$metavals ) {
1644 $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect,$infodbtype,
1645 $docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1646
1647 if($metamode eq "override") { # now, having overridden the metavalue for the first,
1648 # need to accumulate subsequent metavals for this metaname, else the just-assigned
1649 # metavalue for this metaname will be lost
1650 $metamode = "accumulate";
1651 }
1652 }
1653 }
1654 }
1655
1656 if ($status != 0) {
1657 # Catch error if set infodb entry failed
1658 $global_status = $status;
1659 $global_mess .= "Failed to set metadata key: $docid\n";
1660 $global_mess .= "Exit status: $status\n";
1661 $global_mess .= "System Error Message: $!\n";
1662 $global_mess .= "-" x 20 . "\n";
1663 }
1664 }
1665
1666 if ($global_status != 0) {
1667 $global_mess .= "PATH: $ENV{'PATH'}\n";
1668 $gsdl_cgi->generate_error($global_mess);
1669 }
1670 else {
1671 my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1672 $gsdl_cgi->generate_ok_message($mess);
1673 }
1674}
1675
1676sub set_archives_metadata_array
1677{
1678 my $self = shift @_;
1679
1680 my $username = $self->{'username'};
1681 my $collect = $self->{'collect'};
1682 my $gsdl_cgi = $self->{'gsdl_cgi'};
1683# my $gsdlhome = $self->{'gsdlhome'};
1684
1685 if ($baseaction::authentication_enabled) {
1686 # Ensure the user is allowed to edit this collection
1687 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1688 }
1689
1690 my $site = $self->{'site'};
1691 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1692
1693 $gsdl_cgi->checked_chdir($collect_dir);
1694
1695 # Obtain the collect dir
1696 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
1697
1698 # Make sure the collection isn't locked by someone else
1699 $self->lock_collection($username, $collect);
1700
1701 $self->_set_archives_metadata_array(@_);
1702
1703 # Release the lock once it is done
1704 $self->unlock_collection($username, $collect);
1705}
1706
1707sub _remove_archives_metadata
1708{
1709 my $self = shift @_;
1710
1711 my $collect = $self->{'collect'};
1712 my $gsdl_cgi = $self->{'gsdl_cgi'};
1713# my $gsdlhome = $self->{'gsdlhome'};
1714 my $infodbtype = $self->{'infodbtype'};
1715
1716 my $site = $self->{'site'};
1717
1718 # Obtain the collect and archive dir
1719 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1720
1721 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1722
1723 # look up additional args
1724 my ($docid, $docid_secnum) = ($self->{'d'} =~ m/^(.*?)(\..*)?$/);
1725
1726 my $metaname = $self->{'metaname'};
1727 my $metapos = $self->{'metapos'};
1728
1729 my $metavalue = $self->{'metavalue'} || undef; # necessary to force fallback to undef here
1730
1731 # if the user hasn't told us what to delete, not having given a metavalue or metapos,
1732 # default to deleting the first metavalue for the given metaname
1733 # Beware that if both metapos AND metavalue are defined, both matches (if any)
1734 # seem to get deleted in one single remove_archives_meta action invocation.
1735 # Similarly, if 2 identical metavalues for a metaname exist and that metavalue is being
1736 # deleted, both get deleted.
1737 if(!defined $metapos && !defined $metavalue) {
1738 $metapos = 0;
1739 }
1740
1741 my $metamode = $self->{'metamode'} || undef;
1742
1743 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1744 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1745
1746 # This now stores the full pathname
1747 my $doc_filename = $doc_rec->{'doc-file'}->[0];
1748
1749 my $status = $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, $metavalue, $docid_secnum, $metamode);
1750# my $status = $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, undef, $docid_secnum);
1751
1752 if ($status == 0)
1753 {
1754 my $mess = "remove-archives-metadata successful: Key[$docid]\n";
1755 $mess .= " $metaname";
1756 $mess .= "->[$metapos]" if (defined $metapos);
1757
1758 $gsdl_cgi->generate_ok_message($mess);
1759 }
1760 else
1761 {
1762 my $mess .= "Failed to remove archives metadata key: $docid\n";
1763 $mess .= "Exit status: $status\n";
1764 $mess .= "System Error Message: $!\n";
1765 $mess .= "-" x 20 . "\n";
1766
1767 $gsdl_cgi->generate_error($mess);
1768 }
1769
1770 #return $status; # in case calling functions have a use for this
1771}
1772
1773sub remove_archives_metadata
1774{
1775 my $self = shift @_;
1776
1777 my $username = $self->{'username'};
1778 my $collect = $self->{'collect'};
1779 my $gsdl_cgi = $self->{'gsdl_cgi'};
1780
1781 if ($baseaction::authentication_enabled)
1782 {
1783 # Ensure the user is allowed to edit this collection
1784 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1785 }
1786
1787 # Make sure the collection isn't locked by someone else
1788 $self->lock_collection($username, $collect);
1789
1790 $self->_remove_archives_metadata(@_);
1791
1792 # Release the lock once it is done
1793 $self->unlock_collection($username, $collect);
1794}
1795
1796sub remove_from_doc_xml
1797{
1798 my $self = shift @_;
1799 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metapos, $metavalue, $secid, $metamode) = @_;
1800
1801 my @start_rules = ('Section' => \&dxml_start_section);
1802
1803 # Set the call-back functions for the metadata tags
1804 my @rules =
1805 (
1806 _default => 'raw',
1807 'Metadata' => \&rfdxml_metadata
1808 );
1809
1810 my $parser = XML::Rules->new
1811 (
1812 start_rules => \@start_rules,
1813 rules => \@rules,
1814 style => 'filter',
1815 output_encoding => 'utf8',
1816# normalisespaces => 1, # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1817 stripspaces => 2|0|0 # ineffectual
1818 );
1819
1820 my $status = 0;
1821 my $xml_in = "";
1822 if (!open(MIN,"<$doc_xml_filename"))
1823 {
1824 $gsdl_cgi->generate_error("Unable to read in $doc_xml_filename: $!");
1825 $status = 1;
1826 }
1827 else
1828 {
1829 # Read them in
1830 my $line;
1831 while (defined ($line=<MIN>)) {
1832 $xml_in .= $line;
1833 }
1834 close(MIN);
1835
1836 # Filter with the call-back functions
1837 my $xml_out = "";
1838
1839 my $MOUT;
1840 if (!open($MOUT,">$doc_xml_filename")) {
1841 $gsdl_cgi->generate_error("Unable to write out to $doc_xml_filename: $!");
1842 $status = 1;
1843 }
1844 else {
1845 binmode($MOUT,":utf8");
1846 $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, secid => $secid, metamode => $metamode});
1847 close($MOUT);
1848 }
1849 }
1850 return $status;
1851}
1852
1853sub rfdxml_metadata
1854{
1855 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1856
1857 # For comparisons, toplevel section is indicated by ""
1858 my $curr_sec_num = $parser->{'parameters'}->{'curr_section_num'} || "";
1859 my $secid = $parser->{'parameters'}->{'secid'} || "";
1860
1861 if (!($secid eq $curr_sec_num))
1862 {
1863 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1864 return [$tagname => $attrHash];
1865 }
1866
1867 if ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
1868 {
1869 if (!defined $parser->{'parameters'}->{'poscount'})
1870 {
1871 $parser->{'parameters'}->{'poscount'} = 0;
1872 }
1873 else
1874 {
1875 $parser->{'parameters'}->{'poscount'}++;
1876 }
1877
1878 # if overriding (for set-meta) but no metapos, then clear all the meta for this metaname
1879 if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'})) {
1880 return [];
1881 }
1882 }
1883
1884 if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
1885 {
1886 return [];
1887 }
1888
1889 if ((defined $parser->{'parameters'}->{'metavalue'}) && ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'}) && ($parser->{'parameters'}->{'metavalue'} eq $attrHash->{'_content'}))
1890 {
1891 return [];
1892 }
1893
1894 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1895 return [$tagname => $attrHash];
1896}
1897
1898sub mxml_metadata
1899{
1900 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1901 my $metaname = $parser->{'parameters'}->{'metaname'};
1902 my $metamode = $parser->{'parameters'}->{'metamode'};
1903
1904 # Report error if we don't see FileName tag before this
1905 die "Fatal Error: Unexpected metadata.xml structure. Undefined current_file, possibly encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1906
1907 # Don't do anything if we are not in the right FileSet
1908 my $file_regexp = $parser->{'parameters'}->{'current_file'};
1909 if ($file_regexp =~ /\.\*/) {
1910 # Only interested in a file_regexp if it specifies precisely one
1911 # file.
1912 # So, skip anything with a .* in it as it is too general
1913## print STDERR "@@@@ Skipping entry in metadata.xml where FileName=.* as it is too general\n";
1914 return [$tagname => $attrHash];
1915 }
1916 my $src_file = $parser->{'parameters'}->{'src_file'};
1917 if (!($src_file =~ /$file_regexp/)) {
1918 return [$tagname => $attrHash];
1919 }
1920## print STDERR "*** mxl metamode = $metamode\n";
1921
1922 # Find the right metadata tag and checks if we are going to override it
1923 my $name_attr = $attrHash->{'name'};
1924 if (($name_attr eq $metaname) && ($metamode eq "override")) {
1925
1926 # now metadata.xml functions need to keep track of metapos
1927 if (!defined $parser->{'parameters'}->{'poscount'})
1928 {
1929 $parser->{'parameters'}->{'poscount'} = 0;
1930 }
1931 else
1932 {
1933 $parser->{'parameters'}->{'poscount'}++;
1934 }
1935
1936 # If either the metapos or prevmetavalue is set,
1937 # get the value and override the current value
1938 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1939
1940 if(defined $parser->{'parameters'}->{'prevmetavalue'} && $parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'})
1941 {
1942 $attrHash->{'_content'} = $metavalue;
1943
1944 ## print STDERR "**** overriding metadata.xml\n";
1945
1946 # Don't want it to wipe out any other pieces of metadata
1947 $parser->{'parameters'}->{'metamode'} = "done";
1948 }
1949 elsif(defined $parser->{'parameters'}->{'metapos'} && $parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'})
1950 {
1951 $attrHash->{'_content'} = $metavalue;
1952 $parser->{'parameters'}->{'metamode'} = "done";
1953 }
1954 }
1955
1956 # mxml_description will process the metadata if metadata is accumulate,
1957 # or if we haven't found the metadata to override
1958
1959 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1960 return [$tagname => $attrHash];
1961}
1962
1963
1964sub mxml_description
1965{
1966 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1967 my $metamode = $parser->{'parameters'}->{'metamode'};
1968
1969 # Failed... Report error if we don't see FileName tag before this
1970 die "Fatal Error: Unexpected metadata.xml structure. Undefind current_file, possiblely encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1971
1972 # Don't do anything if we are not in the right FileSet
1973 my $file_regexp = $parser->{'parameters'}->{'current_file'};
1974 if ($file_regexp =~ m/\.\*/) {
1975 # Only interested in a file_regexp if it specifies precisely one
1976 # file.
1977 # So, skip anything with a .* in it as it is too general
1978 return [$tagname => $attrHash];
1979 }
1980 my $src_file = $parser->{'parameters'}->{'src_file'};
1981
1982 if (!($src_file =~ m/$file_regexp/)) {
1983 return [$tagname => $attrHash];
1984 }
1985
1986 # Accumulate the metadata block to the end of the description block
1987 # Note: This adds metadata block to all description blocks, so if there are
1988 # multiple FileSets, it will add to all of them
1989 if (($metamode eq "accumulate") || ($metamode eq "override")) {
1990
1991 # if metamode was "override" but get to here then it failed to
1992 # find an item to override, in which case it should append its
1993 # value to the end, just like the "accumulate" mode
1994
1995 if ($metamode eq "override") {
1996 print "No metadata value to override. Switching 'metamode' to accumulate\n";
1997 }
1998
1999 # tack a new metadata tag on to the end of the <Metadata>+ block
2000 my $metaname = $parser->{'parameters'}->{'metaname'};
2001 my $metavalue = $parser->{'parameters'}->{'metavalue'};
2002
2003 my $metadata_attr = { '_content' => $metavalue,
2004 'name' => $metaname,
2005 'mode' => "accumulate" };
2006
2007 my $append_metadata = [ "Metadata" => $metadata_attr ];
2008 my $description_content = $attrHash->{'_content'};
2009
2010## print STDERR "*** appending to metadata.xml\n";
2011
2012 # append the new metadata element to the end of the current
2013 # content contained inside this tag
2014 if (ref($description_content) eq "") {
2015 # => string or numeric literal
2016 # this is caused by a <Description> block has no <Metadata> child elements
2017 # => set up an empty array in '_content'
2018 $attrHash->{'_content'} = [ "\n" ];
2019 $description_content = $attrHash->{'_content'};
2020 }
2021
2022 push(@$description_content," ", $append_metadata ,"\n ");
2023 $parser->{'parameters'}->{'metamode'} = "done";
2024 }
2025
2026 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2027 return [$tagname => $attrHash];
2028}
2029
2030
2031sub mxml_filename
2032{
2033 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2034
2035 # Store the filename of the Current Fileset
2036 # Note: According to http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd
2037 # FileName tag must come before Description tag
2038 $parser->{'parameters'}->{'current_file'} = $attrHash->{'_content'};
2039
2040 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2041 return [$tagname => $attrHash];
2042}
2043
2044
2045sub mxml_fileset
2046{
2047 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2048
2049 # Initilise the current_file
2050 # Note: According to http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd
2051 # FileName tag must come before Description tag
2052 $parser->{'parameters'}->{'current_file'} = "";
2053
2054 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2055 return [$tagname => $attrHash];
2056}
2057
2058sub mxml_directorymetadata
2059{
2060 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2061
2062 # if we haven't processed the metadata when we reach the end of metadata.xml
2063 # it's because there's no particular FileSet element whose FileName matched
2064 # In which case, add a new FileSet for this FileName
2065 my $metamode = $parser->{'parameters'}->{'metamode'};
2066 if($metamode ne "done") {
2067
2068 if ($metamode eq "override") {
2069 print "No metadata value to override. Switching 'metamode' to accumulate\n";
2070 }
2071
2072 # If we get to here and metamode is override, this means there
2073 # was no existing value to overide => treat as an append operation
2074
2075 # Create a new FileSet element and append to DirectoryMetadata
2076 # <FileSet>
2077 # <FileName>src_file</FileName>
2078 # <Description>
2079 # <Metadata mode="" name="">metavalue</Metadata>
2080 # </Description>
2081 # </FileSet>
2082 my $src_file = $parser->{'parameters'}->{'src_file'};
2083 my $metaname = $parser->{'parameters'}->{'metaname'};
2084 my $metavalue = $parser->{'parameters'}->{'metavalue'};
2085 my $metadata_attr = {
2086 '_content' => $metavalue,
2087 'name' => $metaname,
2088 'mode' => "accumulate"
2089 };
2090 my $append_metadata = [ "Metadata" => $metadata_attr ];
2091 my $description_attr->{'_content'} = [ "\n\t\t ", $append_metadata, "\n\t\t"];
2092 my $description_element = [ "Description" => $description_attr ];
2093
2094 #_content is not an attribute, it's special and holds the children of this element
2095 # including the textnode value embedded in this element if any.
2096 my $filename_attr = {'_content' => $src_file};
2097 my $filename_element = [ "FileName" => $filename_attr ];
2098
2099 my $fileset_attr = {};
2100 $fileset_attr->{'_content'} = [ "\n\t\t", $filename_element,"\n\t\t",$description_element ,"\n\t" ];
2101 my $fileset = [ "FileSet" => $fileset_attr ]; #my $fileset = [ "FileSet" => {} ];
2102
2103
2104 # get children of dirmeta, and push the new FileSet element onto it
2105 print "Appending metadata to metadata.xml\n";
2106 my $dirmeta_content = $attrHash->{'_content'};
2107 if (ref($dirmeta_content)) {
2108 # got some existing interesting nested content
2109 #push(@$dirmeta_content, " ", $fileset ,"\n ");
2110 push(@$dirmeta_content, "\t", $fileset ,"\n");
2111 }
2112 else {
2113 #description_content is most likely a string such as "\n"
2114 #$attrHash->{'_content'} = [$dirmeta_content, " ", $fileset ,"\n" ];
2115 $attrHash->{'_content'} = [$dirmeta_content, "\t", $fileset ,"\n" ];
2116 }
2117
2118 $parser->{'parameters'}->{'metamode'} = "done";
2119 }
2120 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2121 return [$tagname => $attrHash];
2122}
2123
2124
2125sub edit_metadata_xml
2126{
2127 my $self = shift @_;
2128 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $metamode, $src_file, $prevmetavalue) = @_;
2129
2130 # Set the call-back functions for the metadata tags
2131 my @rules =
2132 ( _default => 'raw',
2133 'FileName' => \&mxml_filename,
2134 'Metadata' => \&mxml_metadata,
2135 'Description' => \&mxml_description,
2136 'FileSet' => \&mxml_fileset,
2137 'DirectoryMetadata' => \&mxml_directorymetadata);
2138
2139 # use XML::Rules to add it in (read in and out again)
2140 my $parser = XML::Rules->new(rules => \@rules,
2141 style => 'filter',
2142 output_encoding => 'utf8',
2143 stripspaces => 2|0|0); # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
2144
2145 if (!-e $metadata_xml_filename) {
2146
2147 if (open(MOUT,">$metadata_xml_filename")) {
2148
2149 my $src_file_re = &util::filename_to_regex($src_file);
2150 # shouldn't the following also be in the above utility routine??
2151 # $src_file_re =~ s/\./\\./g;
2152
2153 print MOUT "<?xml version=\"1.0\"?>\n";
2154 print MOUT "<DirectoryMetadata>\n";
2155 print MOUT " <FileSet>\n";
2156 print MOUT " <FileName>$src_file_re</FileName>\n";
2157 print MOUT " <Description>\n";
2158 print MOUT " </Description>\n";
2159 print MOUT " </FileSet>\n";
2160 print MOUT "</DirectoryMetadata>\n";
2161
2162 close(MOUT);
2163 }
2164 else {
2165 $gsdl_cgi->generate_error("Unable to create $metadata_xml_filename: $!");
2166 }
2167 }
2168
2169
2170 my $xml_in = "";
2171 if (!open(MIN,"<$metadata_xml_filename")) {
2172 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
2173 }
2174 else {
2175 # Read them in
2176 my $line;
2177 while (defined ($line=<MIN>)) {
2178 $xml_in .= $line;
2179 }
2180 close(MIN);
2181
2182 # Filter with the call-back functions
2183 my $xml_out = "";
2184
2185 my $MOUT;
2186 if (!open($MOUT,">$metadata_xml_filename")) {
2187 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
2188 }
2189 else {
2190 binmode($MOUT,":utf8");
2191
2192 # Some wise person please find out how to keep the DTD and encode lines in after it gets filtered by this XML::Rules
2193 # At the moment, I will just hack it!
2194 #my $header_with_utf8_dtd = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
2195 #$header_with_utf8_dtd .= "<!DOCTYPE DirectoryMetadata SYSTEM \"http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd\">";
2196 #$xml_out =~ s/\<\?xml\sversion\=\"1.0\"\?\>/$header_with_utf8_dtd/;
2197 #print MOUT $xml_out;
2198
2199 $parser->filter($xml_in, $MOUT, { metaname => $metaname,
2200 metapos => $metapos,
2201 metavalue => $metavalue,
2202 metamode => $metamode,
2203 src_file => $src_file,
2204 prevmetavalue => $prevmetavalue,
2205 current_file => undef} );
2206 close($MOUT);
2207 }
2208 }
2209}
2210
2211
2212sub set_import_metadata
2213{
2214 my $self = shift @_;
2215
2216 my $username = $self->{'username'};
2217 my $collect = $self->{'collect'};
2218 my $gsdl_cgi = $self->{'gsdl_cgi'};
2219
2220 if ($baseaction::authentication_enabled) {
2221 # Ensure the user is allowed to edit this collection
2222 $self->authenticate_user($username, $collect);
2223 }
2224
2225 # Make sure the collection isn't locked by someone else
2226 $self->lock_collection($username, $collect);
2227
2228 $self->_set_import_metadata(@_);
2229
2230 # Release the lock once it is done
2231 $self->unlock_collection($username, $collect);
2232
2233}
2234
2235sub set_import_metadata_array
2236{
2237 my $self = shift @_;
2238
2239 my $username = $self->{'username'};
2240 my $collect = $self->{'collect'};
2241 my $gsdl_cgi = $self->{'gsdl_cgi'};
2242# my $gsdlhome = $self->{'gsdlhome'};
2243
2244 if ($baseaction::authentication_enabled) {
2245 # Ensure the user is allowed to edit this collection
2246 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2247 }
2248
2249 my $site = $self->{'site'};
2250 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2251
2252 $gsdl_cgi->checked_chdir($collect_dir);
2253
2254 # Make sure the collection isn't locked by someone else
2255 $self->lock_collection($username, $collect);
2256
2257 $self->_set_import_metadata_array(@_);
2258
2259 # Release the lock once it is done
2260 $self->unlock_collection($username, $collect);
2261
2262}
2263
2264
2265sub _set_import_metadata_array
2266{
2267 my $self = shift @_;
2268
2269 my $collect = $self->{'collect'};
2270 my $gsdl_cgi = $self->{'gsdl_cgi'};
2271
2272 my $site = $self->{'site'};
2273 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2274
2275 # look up additional args
2276
2277 my $infodbtype = $self->{'infodbtype'};
2278
2279 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2280 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2281
2282 my $json_str = $self->{'json'};
2283 my $doc_array = decode_json $json_str;
2284
2285 my $global_status = 0;
2286 my $global_mess = "";
2287
2288 my @all_docids = ();
2289
2290 foreach my $doc_array_rec ( @$doc_array )
2291 {
2292 my $status = -1;
2293 my $docid = $doc_array_rec->{'docid'};
2294
2295 my ($docid_root,$docid_secnum);
2296 if(defined $docid) {
2297 ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
2298 # as yet no support for setting subsection metadata in metadata.xml
2299 if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
2300 $gsdl_cgi->generate_message("*** docid: $docid. No support yet for setting import metadata at subsections level.\n");
2301 next; # skip this docid in for loop
2302 }
2303 }
2304
2305 push(@all_docids,$docid); # docid_root rather
2306
2307 my $metaname = $doc_array_rec->{'metaname'};
2308 if (defined $metaname) {
2309 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
2310 my $metavalue = $doc_array_rec->{'metavalue'};
2311 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2312
2313 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
2314 # make "accumulate" the default (less destructive, as won't actually
2315 # delete any existing values)
2316 $metamode = "accumulate";
2317 }
2318
2319 # adding metapos and prevmetavalue support to import_metadata subroutines
2320 my $metapos = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
2321 my $prevmetavalue = $self->{'prevmetavalue'};
2322
2323 $self->set_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid_root, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue, $collect, $collect_dir); # at this point, docid_root = docid
2324
2325 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
2326 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
2327
2328 foreach my $metatable_rec ( @$metatable ) {
2329 $metaname = $metatable_rec->{'metaname'};
2330 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
2331 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
2332 # make "accumulate" the default (less destructive, as won't actually
2333 # delete any existing values)
2334 $metamode = "accumulate";
2335 }
2336
2337 # No support for metapos and prevmetavalue in the JSON metatable substructure
2338 my $metapos = undef;
2339 my $prevmetavalue = undef;
2340 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
2341
2342 foreach my $metavalue ( @$metavals ) {
2343 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2344
2345 $self->set_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid_root, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue, $collect, $collect_dir); # at this point, docid_root = docid
2346 if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
2347 # need to accumulate subsequent metavals for this metaname, else the just-assigned
2348 # metavalue for this metaname will be lost
2349 $metamode = "accumulate";
2350 }
2351 }
2352 }
2353 }
2354 }
2355
2356 # always a success message
2357 my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
2358 $gsdl_cgi->generate_ok_message($mess);
2359}
2360
2361# always returns true (1)
2362sub set_import_metadata_entry
2363{
2364 my $self = shift @_;
2365 my ($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue, $collect, $collect_dir) = @_;
2366
2367 my $info_mess = <<RAWEND;
2368****************************
2369 set_import_metadata_entry()
2370****************************
2371collect = $collect
2372collect_dir = $collect_dir
2373infodbtype = $infodbtype
2374arcinfo_doc_filename = $arcinfo_doc_filename
2375docid = $docid
2376metaname = $metaname
2377metapos = $metapos
2378metavalue = $metavalue
2379metamode = $metamode
2380prevmetavalue = $prevmetavalue
2381****************************
2382RAWEND
2383
2384 $gsdl_cgi->generate_message($info_mess);
2385
2386 # import works with metadata.xml which can have inherited metadata
2387 # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
2388 # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
2389 # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
2390 # what they're doing if they provide a metapos.
2391 if(defined $metapos) {
2392 print STDERR "@@@@ WARNING: metapos defined.\n";
2393 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
2394 }
2395
2396 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2397 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2398 my $metadata_xml_file;
2399 my $import_filename = undef;
2400
2401 if (defined $docid) {
2402 # my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2403 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2404
2405 # This now stores the full pathname
2406 $import_filename = $doc_rec->{'src-file'}->[0];
2407 } else { # only for set_import_meta, not the case when calling method is set_import_metadata_array
2408 # as the array version of the method doesn't support the -f parameter yet
2409 my $import_file = $self->{'f'};
2410 $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
2411 }
2412
2413 # figure out correct metadata.xml file [?]
2414 # Assuming the metadata.xml file is next to the source file
2415 # Note: This will not work if it is using the inherited metadata from the parent folder
2416 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2417 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2418
2419 # If we're overriding everything, then $metamode=override combined with $metapos=undefined
2420 # in which case, we need to remove all metavalues for the metaname at the given (sub)section
2421 # Thereafter, we will finally be able to set the overriding metavalue for this metaname
2422 if(!defined $metapos && $metamode eq "override") {
2423## print STDERR "@@@ REMOVING all import metadata for $metaname\n";
2424 $self->remove_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, undef, $import_tailname, $metamode); # we're removing all values, so metavalue=undef
2425
2426 }
2427
2428 # Edit the metadata.xml
2429 # Modified by Jeffrey from DL Consulting
2430 # Handle the case where there is one metadata.xml file for multiple FileSets
2431 # The XML filter needs to know whether it is in the right FileSet
2432 # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2433 # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2434 $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2435 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2436 #return 0;
2437 return $metadata_xml_filename;
2438}
2439
2440sub _remove_import_metadata
2441{
2442 my $self = shift @_;
2443
2444 my $collect = $self->{'collect'};
2445 my $gsdl_cgi = $self->{'gsdl_cgi'};
2446# my $gsdlhome = $self->{'gsdlhome'};
2447 my $infodbtype = $self->{'infodbtype'};
2448
2449 # Obtain the collect dir
2450 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2451 my $site = $self->{'site'};
2452 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2453
2454 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2455 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2456
2457 # look up additional args
2458 my $docid = $self->{'d'};
2459 if ((!defined $docid) || ($docid =~ m/^\s*$/))
2460 {
2461 $gsdl_cgi->generate_error("No docid (d=...) specified.\n");
2462 }
2463
2464 my $metaname = $self->{'metaname'};
2465 my $metapos = $self->{'metapos'};
2466 my $metavalue = $self->{'metavalue'};
2467 if(defined $metavalue) {
2468 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2469 } elsif (!defined $metapos) { # if given no metavalue or metapos to delete, default to deleting the 1st
2470 $metapos = 0;
2471 }
2472 my $metamode = $self->{'metamode'} || undef;
2473
2474 # import works with metadata.xml which can have inherited metadata
2475 # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
2476 # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
2477 # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
2478 # what they're doing if they provide a metapos.
2479 if(defined $metapos) {
2480 print STDERR "@@@@ WARNING: metapos defined.\n";
2481 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
2482 }
2483
2484 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2485 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2486 my $metadata_xml_file;
2487 my $import_filename = undef;
2488 if (defined $docid)
2489 {
2490 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2491 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2492
2493 # This now stores the full pathname
2494 $import_filename = $doc_rec->{'src-file'}->[0];
2495 }
2496
2497 if((!defined $import_filename) || ($import_filename =~ m/^\s*$/))
2498 {
2499 $gsdl_cgi->generate_error("There is no metadata\n");
2500 }
2501
2502 # figure out correct metadata.xml file [?]
2503 # Assuming the metadata.xml file is next to the source file
2504 # Note: This will not work if it is using the inherited metadata from the parent folder
2505 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2506 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2507
2508 $self->remove_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $import_tailname, $metamode); # metamode has no meaning for removing meta, but is used by set_meta when overriding All
2509
2510 my $mess = "remove-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
2511 $mess .= " $metaname";
2512 $mess .= " = $metavalue\n";
2513
2514 $gsdl_cgi->generate_ok_message($mess);
2515
2516 #return $status; # in case calling functions have a use for this
2517}
2518
2519sub remove_import_metadata
2520{
2521 my $self = shift @_;
2522
2523 my $username = $self->{'username'};
2524 my $collect = $self->{'collect'};
2525 my $gsdl_cgi = $self->{'gsdl_cgi'};
2526
2527 if ($baseaction::authentication_enabled) {
2528 # Ensure the user is allowed to edit this collection
2529 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2530 }
2531
2532 # Make sure the collection isn't locked by someone else
2533 $self->lock_collection($username, $collect);
2534
2535 $self->_remove_import_metadata(@_);
2536
2537 # Release the lock once it is done
2538 $self->unlock_collection($username, $collect);
2539
2540}
2541
2542sub remove_from_metadata_xml
2543{
2544 my $self = shift @_;
2545 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $src_file, $metamode) = @_;
2546 # metamode generally has no meaning for removing meta, but is used by set_meta
2547 # when overriding all metavals for a metaname, in which case remove_meta is called with metamode
2548
2549 # Set the call-back functions for the metadata tags
2550 my @rules =
2551 (
2552 _default => 'raw',
2553 'Metadata' => \&rfmxml_metadata,
2554 'FileName' => \&mxml_filename
2555 );
2556
2557 my $parser = XML::Rules->new
2558 (
2559 rules => \@rules,
2560 style => 'filter',
2561 output_encoding => 'utf8',
2562 #normalisespaces => 1,
2563 stripspaces => 2|0|0 # ineffectual
2564 );
2565
2566 my $xml_in = "";
2567 if (!open(MIN,"<$metadata_xml_filename"))
2568 {
2569 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
2570 }
2571 else
2572 {
2573 # Read them in
2574 my $line;
2575 while (defined ($line=<MIN>)) {
2576 $xml_in .= $line;
2577 }
2578 close(MIN);
2579
2580 # Filter with the call-back functions
2581 my $xml_out = "";
2582
2583 my $MOUT;
2584 if (!open($MOUT,">$metadata_xml_filename")) {
2585 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
2586 }
2587 else {
2588 binmode($MOUT,":utf8");
2589 $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, src_file => $src_file, metamode => $metamode, current_file => undef});
2590 close($MOUT);
2591 }
2592 }
2593}
2594
2595sub rfmxml_metadata
2596{
2597 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2598
2599 # metadata.xml does not handle subsections
2600
2601 # since metadata.xml now has to deal with metapos, we keep track of the metadata position
2602 if (($parser->{'parameters'}->{'src_file'} eq $parser->{'parameters'}->{'current_file'})
2603 && $parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
2604 {
2605 if (!defined $parser->{'parameters'}->{'poscount'})
2606 {
2607 $parser->{'parameters'}->{'poscount'} = 0;
2608 }
2609 else
2610 {
2611 $parser->{'parameters'}->{'poscount'}++;
2612 }
2613
2614 # if overriding but no metapos, then clear all the meta for this metaname
2615 if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'})) {
2616 return [];
2617 }
2618
2619 if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
2620 {
2621 return [];
2622 }
2623
2624 if ((defined $parser->{'parameters'}->{'metavalue'}) && ($attrHash->{'_content'} eq $parser->{'parameters'}->{'metavalue'}))
2625 {
2626 return [];
2627 }
2628 }
2629
2630 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2631 return [$tagname => $attrHash];
2632}
2633
2634sub _remove_live_metadata
2635{
2636 my $self = shift @_;
2637
2638 my $collect = $self->{'collect'};
2639 my $gsdl_cgi = $self->{'gsdl_cgi'};
2640# my $gsdlhome = $self->{'gsdlhome'};
2641 my $infodbtype = $self->{'infodbtype'};
2642
2643 # Obtain the collect dir
2644 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2645 my $site = $self->{'site'};
2646 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2647
2648
2649 # look up additional args
2650 my $docid = $self->{'d'};
2651 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2652 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2653 }
2654
2655 # Generate the dbkey
2656 my $metaname = $self->{'metaname'};
2657 my $dbkey = "$docid.$metaname";
2658
2659 # To people who know $collect_tail please add some comments
2660 # Obtain the live gdbm_db path
2661 my $collect_tail = $collect;
2662 $collect_tail =~ s/^.*[\/\\]//;
2663 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2664 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
2665
2666 # Remove the key
2667 my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\"";
2668 my $status = system($cmd);
2669 if ($status != 0) {
2670 # Catch error if gdbmdel failed
2671 my $mess = "Failed to set metadata key: $dbkey\n";
2672
2673 $mess .= "PATH: $ENV{'PATH'}\n";
2674 $mess .= "cmd = $cmd\n";
2675 $mess .= "Exit status: $status\n";
2676 $mess .= "System Error Message: $!\n";
2677
2678 $gsdl_cgi->generate_error($mess);
2679 }
2680 else {
2681 $gsdl_cgi->generate_ok_message("DB remove successful: Key[$metaname]");
2682 }
2683
2684}
2685
2686sub remove_live_metadata
2687{
2688 my $self = shift @_;
2689
2690 my $username = $self->{'username'};
2691 my $collect = $self->{'collect'};
2692 my $gsdl_cgi = $self->{'gsdl_cgi'};
2693 my $gsdlhome = $self->{'gsdlhome'};
2694
2695 if ($baseaction::authentication_enabled) {
2696 # Ensure the user is allowed to edit this collection
2697 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2698 }
2699
2700 # Make sure the collection isn't locked by someone else
2701 $self->lock_collection($username, $collect);
2702
2703 $self->_remove_live_metadata(@_);
2704
2705 $self->unlock_collection($username, $collect);
2706}
2707
2708sub remove_metadata
2709{
2710 my $self = shift @_;
2711
2712 my $where = $self->{'where'};
2713 if(!$where) {
2714 $self->remove_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
2715 return;
2716 }
2717
2718 my $username = $self->{'username'};
2719 my $collect = $self->{'collect'};
2720 my $gsdl_cgi = $self->{'gsdl_cgi'};
2721
2722 if ($baseaction::authentication_enabled) {
2723 # Ensure the user is allowed to edit this collection
2724 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2725 }
2726
2727 # Make sure the collection isn't locked by someone else
2728 $self->lock_collection($username, $collect);
2729
2730 # check which directories need to be processed, specified in $where as
2731 # any combination of import|archives|index|live
2732 if($where =~ m/import/) {
2733 $self->_remove_import_metadata(@_);
2734 }
2735 if($where =~ m/archives/) {
2736 $self->_remove_archives_metadata(@_);
2737 }
2738 if($where =~ m/index/) {
2739 $self->_remove_index_metadata(@_);
2740 }
2741
2742 # Release the lock once it is done
2743 $self->unlock_collection($username, $collect);
2744}
2745
2746# the internal version, without authentication
2747sub _remove_index_metadata
2748{
2749 my $self = shift @_;
2750
2751 my $collect = $self->{'collect'};
2752 my $gsdl_cgi = $self->{'gsdl_cgi'};
2753# my $gsdlhome = $self->{'gsdlhome'};
2754 my $infodbtype = $self->{'infodbtype'};
2755
2756 # Obtain the collect dir
2757 my $site = $self->{'site'};
2758 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2759 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2760
2761 # look up additional args
2762 my $docid = $self->{'d'};
2763 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2764 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2765 }
2766 my $metaname = $self->{'metaname'};
2767 my $metapos = $self->{'metapos'};
2768 my $metavalue = $self->{'metavalue'} || undef; # necessary to force fallback to undef here
2769
2770 # To people who know $collect_tail please add some comments
2771 # Obtain the path to the database
2772 my $collect_tail = $collect;
2773 $collect_tail =~ s/^.*[\/\\]//;
2774 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2775 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2776
2777 # Read the docid entry
2778 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2779
2780 # Check to make sure the key does exist
2781 if (!defined ($doc_rec->{$metaname})) {
2782 $gsdl_cgi->generate_error("No metadata field \"" . $metaname . "\" in the specified document: [" . $docid . "]");
2783 }
2784
2785 # Obtain the specified metadata pos
2786 # if no metavalue or metapos to delete, default to deleting the 1st value for the metaname
2787 if(!defined $metapos && !defined $metavalue) {
2788 $metapos = 0;
2789 }
2790
2791
2792 # consider check key is defined before deleting?
2793 # Loop through the metadata array and ignore the specified position
2794 my $filtered_metadata = [];
2795 my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}});
2796 for (my $i=0; $i<$num_metadata_vals; $i++) {
2797 my $metaval = shift(@{$doc_rec->{$metaname}});
2798
2799 if (!defined $metavalue && $i != $metapos) {
2800 push(@$filtered_metadata,$metaval);
2801 }
2802
2803 if(defined $metavalue && !($metavalue eq $metaval))
2804 {
2805 push(@$filtered_metadata,$metaval);
2806 }
2807 }
2808 $doc_rec->{$metaname} = $filtered_metadata;
2809
2810 ## Use the dbutil set_entry method instead of assuming the database is gdbm
2811 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2812
2813 if ($status != 0) {
2814 my $mess = "Failed to set metadata key: $docid\n";
2815
2816 $mess .= "PATH: $ENV{'PATH'}\n";
2817 $mess .= "Exit status: $status\n";
2818 $mess .= "System Error Message: $!\n";
2819
2820 $gsdl_cgi->generate_error($mess);
2821 }
2822 else {
2823 my $mess = "DB set (with item deleted) successful: Key[$docid]\n";
2824 $mess .= " $metaname";
2825 $mess .= "->[$metapos]" if (defined $metapos);
2826
2827 $gsdl_cgi->generate_ok_message($mess);
2828 }
2829
2830 #return $status; # in case calling functions have a use for this
2831}
2832
2833sub remove_index_metadata
2834{
2835 my $self = shift @_;
2836
2837 my $username = $self->{'username'};
2838 my $collect = $self->{'collect'};
2839 my $gsdl_cgi = $self->{'gsdl_cgi'};
2840# my $gsdlhome = $self->{'gsdlhome'};
2841
2842 if ($baseaction::authentication_enabled) {
2843 # Ensure the user is allowed to edit this collection
2844 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2845 }
2846
2847 # Obtain the collect dir
2848 my $site = $self->{'site'};
2849 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2850 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2851
2852 # Make sure the collection isn't locked by someone else
2853 $self->lock_collection($username, $collect);
2854
2855 $self->_remove_index_metadata(@_);
2856
2857 # Release the lock once it is done
2858 $self->unlock_collection($username, $collect);
2859}
2860
2861
2862# Was trying to reused the codes, but the functions need to be broken
2863# down more before they can be reused, otherwise there will be too
2864# much overhead and duplicate process...
2865sub insert_metadata
2866{
2867 my $self = shift @_;
2868
2869 my $username = $self->{'username'};
2870 my $collect = $self->{'collect'};
2871 my $gsdl_cgi = $self->{'gsdl_cgi'};
2872 my $gsdlhome = $self->{'gsdlhome'};
2873 my $infodbtype = $self->{'infodbtype'};
2874
2875 # If the import metadata and gdbm database have been updated, we
2876 # need to insert some notification to warn user that the the text
2877 # they see at the moment is not indexed and require a rebuild.
2878 my $rebuild_pending_macro = "_rebuildpendingmessage_";
2879
2880 if ($baseaction::authentication_enabled) {
2881 # Ensure the user is allowed to edit this collection
2882 $self->authenticate_user($username, $collect);
2883 }
2884
2885 # Obtain the collect and archive dir
2886 my $site = $self->{'site'};
2887 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2888 ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2889 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2890
2891 # Make sure the collection isn't locked by someone else
2892 $self->lock_collection($username, $collect);
2893
2894 # Check additional args
2895 my $docid = $self->{'d'};
2896 if (!defined($docid)) {
2897 $gsdl_cgi->generate_error("No document id is specified: d=...");
2898 }
2899 my $metaname = $self->{'metaname'};
2900 if (!defined($metaname)) {
2901 $gsdl_cgi->generate_error("No metaname is specified: metadataname=...");
2902 }
2903 my $metavalue = $self->{'metavalue'};
2904 if (!defined($metavalue) || $metavalue eq "") {
2905 $gsdl_cgi->generate_error("No metavalue or empty metavalue is specified: metadataname=...");
2906 }
2907 # make "accumulate" the default (less destructive, as won't actually
2908 # delete any existing values)
2909 my $metamode = "accumulate";
2910
2911 # metapos/prevmetavalue were never before used in this subroutine, so set them to undefined
2912 my $metapos = undef;
2913 my $prevmetavalue = undef;
2914
2915 #=======================================================================#
2916 # set_import_metadata [START]
2917 #=======================================================================#
2918 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2919 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2920 my $metadata_xml_file;
2921 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2922 my $archive_doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2923
2924 # This now stores the full pathname
2925 my $import_filename = $archive_doc_rec->{'src-file'}->[0];
2926
2927 # figure out correct metadata.xml file [?]
2928 # Assuming the metadata.xml file is next to the source file
2929 # Note: This will not work if it is using the inherited metadata from the parent folder
2930 my ($import_tailname, $import_dirname)
2931 = File::Basename::fileparse($import_filename);
2932 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2933
2934 # Shane's escape characters
2935 $metavalue = pack "U0C*", unpack "C*", $metavalue;
2936 $metavalue =~ s/\,/&#44;/g;
2937 $metavalue =~ s/\:/&#58;/g;
2938 $metavalue =~ s/\|/&#124;/g;
2939 $metavalue =~ s/\(/&#40;/g;
2940 $metavalue =~ s/\)/&#41;/g;
2941 $metavalue =~ s/\[/&#91;/g;
2942 $metavalue =~ s/\\/&#92;/g;
2943 $metavalue =~ s/\]/&#93;/g;
2944 $metavalue =~ s/\{/&#123;/g;
2945 $metavalue =~ s/\}/&#125;/g;
2946 $metavalue =~ s/\"/&#34;/g;
2947 $metavalue =~ s/\`/&#96;/g;
2948 $metavalue =~ s/\n/_newline_/g;
2949
2950 # Edit the metadata.xml
2951 # Modified by Jeffrey from DL Consulting
2952 # Handle the case where there is one metadata.xml file for multiple FileSets
2953 # The XML filter needs to know whether it is in the right FileSet
2954 # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2955 # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2956 $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2957 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2958 #=======================================================================#
2959 # set_import_metadata [END]
2960 #=======================================================================#
2961
2962
2963 #=======================================================================#
2964 # set_metadata (accumulate version) [START]
2965 #=======================================================================#
2966 # To people who know $collect_tail please add some comments
2967 # Obtain path to the database
2968 my $collect_tail = $collect;
2969 $collect_tail =~ s/^.*[\/\\]//;
2970 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2971 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2972
2973 # Read the docid entry
2974 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2975
2976 # Protect the quotes
2977 $metavalue =~ s/\"/\\\"/g;
2978
2979 # Adds the pending macro
2980 my $macro_metavalue = $rebuild_pending_macro . $metavalue;
2981
2982 # If the metadata doesn't exist, create a new one
2983 if (!defined($doc_rec->{$metaname})){
2984 $doc_rec->{$metaname} = [ $macro_metavalue ];
2985 }
2986 # Else, let's acculumate the values
2987 else {
2988 push(@{$doc_rec->{$metaname}},$macro_metavalue);
2989 }
2990
2991 ## Use the dbutil set_entry method instead of assuming the database is gdbm
2992 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2993
2994 if ($status != 0) {
2995 # Catch error if gdbmget failed
2996 my $mess = "Failed to set metadata key: $docid\n";
2997
2998 $mess .= "PATH: $ENV{'PATH'}\n";
2999 $mess .= "Exit status: $status\n";
3000 $mess .= "System Error Message: $!\n";
3001
3002 $gsdl_cgi->generate_error($mess);
3003 }
3004 else {
3005 my $mess = "insert-metadata successful: Key[$docid]\n";
3006 $mess .= " [In metadata.xml] $metaname";
3007 $mess .= " = $metavalue\n";
3008 $mess .= " [In database] $metaname";
3009 $mess .= " = $macro_metavalue\n";
3010 $mess .= " The new text has not been indexed, rebuilding collection is required\n";
3011 $gsdl_cgi->generate_ok_message($mess);
3012 }
3013 #=======================================================================#
3014 # set_metadata (accumulate version) [END]
3015 #=======================================================================#
3016
3017 # Release the lock once it is done
3018 $self->unlock_collection($username, $collect);
3019}
3020
30211;
Note: See TracBrowser for help on using the repository browser.