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

Last change on this file since 32077 was 32077, checked in by kjdon, 6 years ago

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