source: main/trunk/greenstone2/perllib/cgiactions/modmetadataaction.pm@ 32849

Last change on this file since 32849 was 32849, checked in by ak19, 5 years ago

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