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

Last change on this file since 32061 was 32061, checked in by ak19, 6 years ago

Moving two subroutines from modmetadataaction.pm to metadataaction.pm since they're already referenced in metadataaction.pm; and since metadataaction.pm includes modmetadataaction.pm anyway, so modmeta won't be missing the moved subroutines.
File size: 92.7 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";
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'} && $parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'})
861 || (!defined $parser->{'parameters'}->{'metapos'} && $parser->{'parameters'}->{'poscount'} == 0))
862
863 {
864 ##print STDERR "#### got match!!\n";
865 # Get the value and override the current value
866 my $metavalue = $parser->{'parameters'}->{'metavalue'};
867 $attrHash->{'_content'} = $metavalue;
868
869 # Don't want it to wipe out any other pieces of metadata
870 $parser->{'parameters'}->{'metamode'} = "done";
871 }
872 elsif (defined $parser->{'parameters'}->{'prevmetavalue'} && $parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'})
873 {
874 my $metavalue = $parser->{'parameters'}->{'metavalue'};
875 $attrHash->{'_content'} = $metavalue;
876 $parser->{'parameters'}->{'metamode'} = "done";
877 }
878 }
879 }
880
881 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
882 return [$tagname => $attrHash];
883}
884
885# This method exists purely for catching invalid section numbers that the client
886# requested to edit. Once the parser has reached the end (the final </Archive> tag),
887# we've seen all the Sections in the doc.xml, and none of their section nums matched
888# if the metamode has not been set to 'done' by then.
889sub dxml_archive
890{
891 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
892 my $metamode = $parser->{'parameters'}->{'metamode'};
893
894 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
895 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
896
897# print STDERR "@@@ $tagname Processing a closing </Archive> tag [$curr_secnum|$opt_doc_secnum]\n";
898
899 if ($metamode ne "done" && $curr_secnum ne $opt_doc_secnum) {
900 print STDERR "@@@ $tagname Finished processing FINAL Section.\n";
901
902 my $metaname = $parser->{'parameters'}->{'metaname'};
903 my $metavalue = $parser->{'parameters'}->{'metavalue'};
904
905 print STDERR "@@@ Requested section number $opt_doc_secnum not found.\n";
906 print STDERR "\t(last seen section number in document was $curr_secnum)\n";
907 print STDERR "\tDiscarded metadata value '$metavalue' for meta '$metaname'\n";
908 print STDERR "\tin section $opt_doc_secnum.\n";
909 $parser->{'custom_err_msg'} = "Requested section number $opt_doc_secnum not found.";
910 }
911
912 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
913 return [$tagname => $attrHash];
914}
915
916sub dxml_description
917{
918 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
919 my $metamode = $parser->{'parameters'}->{'metamode'};
920
921 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
922 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'} || "";
923
924###!!! print STDERR "**** Processing a closing </Description> tag \n";
925# print STDERR "@@@ $tagname Processing a closing </Description> tag [$curr_secnum|$opt_doc_secnum]\n";
926
927 # Accumulate the metadata
928
929 # We'll be accumulating metadata at this point if we haven't found and therefore
930 # haven't processed the metadata yet.
931 # For subsections, this means that if we're at a matching subsection, but haven't
932 # found the correct metaname to override in that subsection, we accumulate it as new
933 # meta in the subsection by adding it to the current description.
934 # If there's no subsection info for the metadata, it will accumulate at the top level
935 # section description if we hadn't found a matching metaname to override at this point.
936
937 # Both curr_secnum and opt_doc_secnum can be "". In the former case, it means we're now
938 # at the toplevel section. In the latter case, it means we want to process meta in the
939 # toplevel section. So the eq check between the values below will work in all cases.
940
941 # The only time this won't work is if an opt_doc_secnum beyond the section numbers of
942 # this document has been provided. In that case, the metadata for that opt_doc_secnum
943 # won't get attached/accumulated to any part of the doc, not even its top-level section.
944
945 if ($curr_secnum eq $opt_doc_secnum
946 && ($metamode eq "accumulate" || $metamode eq "override")) {
947 if ($metamode eq "override") {
948 print "Got to end of <Description> block. No metadata value to override. Switching 'metamode' to accumulate\n";
949 }
950
951 # If we get to here and metamode is override, this means there
952 # was no existing value to overide => treat as an append operation
953
954 # Tack a new metadata tag on to the end of the <Metadata>+ block
955 my $metaname = $parser->{'parameters'}->{'metaname'};
956 my $metavalue = $parser->{'parameters'}->{'metavalue'};
957
958 my $metadata_attr = {
959 '_content' => $metavalue,
960 'name' => $metaname,
961 'mode' => "accumulate"
962 };
963
964 my $append_metadata = [ "Metadata" => $metadata_attr ];
965 my $description_content = $attrHash->{'_content'};
966
967 print "Appending metadata to doc.xml\n";
968
969 if (ref($description_content)) {
970 # got some existing interesting nested content
971 push(@$description_content, " ", $append_metadata ,"\n ");
972 }
973 else {
974 #description_content is most likely a string such as "\n"
975 $attrHash->{'_content'} = [$description_content, " ", $append_metadata ,"\n" ];
976 }
977
978 $parser->{'parameters'}->{'metamode'} = "done";
979 }
980 else {
981 # metamode most likely "done" signifying that it has already found a position to add the metadata to.
982## print STDERR "**** NOT ACCUMULATE?!? \n";
983 }
984
985 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
986 return [$tagname => $attrHash];
987}
988
989sub edit_xml_file
990{
991 my $self = shift @_;
992 my ($gsdl_cgi, $filename, $start_rules, $rules, $options) = @_;
993
994 # use XML::Rules to add it in (read in and out again)
995 my $parser = XML::Rules->new(start_rules => $start_rules,
996 rules => $rules,
997 style => 'filter',
998 output_encoding => 'utf8' );
999
1000 my $xml_in = "";
1001 if (!open(MIN,"<$filename")) {
1002 $gsdl_cgi->generate_error("Unable to read in $filename: $!");
1003 }
1004 else {
1005 # Read all the text in
1006 my $line;
1007 while (defined ($line=<MIN>)) {
1008 $xml_in .= $line;
1009 }
1010 close(MIN);
1011
1012 my $MOUT;
1013 if (!open($MOUT,">$filename")) {
1014 $gsdl_cgi->generate_error("Unable to write out to $filename: $!");
1015 }
1016 else {
1017 # Matched lines will get handled by the call backs
1018## my $xml_out = "";
1019
1020 binmode($MOUT,":utf8");
1021 $parser->filter($xml_in,$MOUT, $options);
1022
1023# binmode(MOUT,":utf8");
1024# print MOUT $xml_out;
1025 close($MOUT);
1026 }
1027 }
1028
1029 # copy across any custom error information that was stored during parsing
1030 $self->{'error_msg'} = $parser->{'custom_err_msg'} if(defined $parser->{'custom_err_msg'});
1031}
1032
1033sub edit_doc_xml
1034{
1035 my $self = shift @_;
1036 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metavalue, $metapos, $metamode, $opt_secnum, $prevmetavalue) = @_;
1037
1038 my $info_mess = <<RAWEND;
1039****************************
1040 edit_doc_xml()
1041****************************
1042RAWEND
1043
1044 $info_mess .= " doc_xml_filename = $doc_xml_filename\n" if defined($doc_xml_filename);
1045 $info_mess .= " metaname = $metaname\n" if defined($metaname);
1046 $info_mess .= " metapos = $metapos\n" if defined($metapos);
1047 $info_mess .= " metavalue = $metavalue\n" if defined($metavalue);
1048 $info_mess .= " metamode = $metamode\n" if defined($metamode);
1049 $info_mess .= " opt_secnum = $opt_secnum\n" if defined($opt_secnum);
1050 $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1051
1052 $info_mess .= "****************************\n";
1053
1054 $gsdl_cgi->generate_message($info_mess);
1055
1056 # To monitor which section/subsection number we are in
1057 my @start_rules =
1058 ( 'Section' => \&dxml_start_section );
1059
1060 # use XML::Rules to add it in (read in and out again)
1061 # Set the call back functions
1062 my @rules =
1063 ( _default => 'raw',
1064 'Metadata' => \&dxml_metadata,
1065 'Description' => \&dxml_description,
1066 'Archive' => \&dxml_archive); # just for catching errors at end
1067
1068 # Sets the parameters
1069 my $options = { 'metaname' => $metaname,
1070 'metapos' => $metapos,
1071 'metavalue' => $metavalue,
1072 'metamode' => $metamode,
1073 'prevmetavalue' => $prevmetavalue };
1074
1075 if (defined $opt_secnum) {
1076 $options->{'secnum'} = $opt_secnum;
1077 }
1078
1079 $self->edit_xml_file($gsdl_cgi,$doc_xml_filename,\@start_rules,\@rules,$options);
1080}
1081
1082sub set_archives_metadata_entry
1083{
1084 my $self = shift @_;
1085 my ($gsdl_cgi, $archive_dir, $collect_dir, $collect, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue) = @_;
1086
1087 my $info_mess = <<RAWEND;
1088****************************
1089 set_archives_metadata_entry()
1090****************************
1091RAWEND
1092
1093 $info_mess .= " archive_dir = $archive_dir\n" if defined($archive_dir);
1094 $info_mess .= " collect_dir = $collect_dir\n" if defined($collect_dir);
1095 $info_mess .= " collect = $collect\n" if defined($collect);
1096 $info_mess .= " infodbtype = $infodbtype\n" if defined($infodbtype);
1097 $info_mess .= " docid = $docid\n" if defined($docid);
1098 $info_mess .= " metaname = $metaname\n" if defined($metaname);
1099 $info_mess .= " metapos = $metapos\n" if defined($metapos);
1100 $info_mess .= " metavalue = $metavalue\n" if defined($metavalue);
1101 $info_mess .= " metamode = $metamode\n" if defined($metamode);
1102 $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1103
1104 $info_mess .= "****************************\n";
1105
1106 $gsdl_cgi->generate_message($info_mess);
1107
1108 # Obtain the doc.xml path for the specified docID
1109 my ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
1110
1111 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1112 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid_root);
1113 my $doc_xml_file = $doc_rec->{'doc-file'}->[0];
1114
1115 # The $doc_xml_file is relative to the archives, and now let's get the full path
1116 my $archives_dir = &util::filename_cat($collect_dir,$collect,"archives");
1117 my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file);
1118
1119 # If we're overriding everything, then $metamode=override combined with $metapos=undefined and $prevmetavalue=undefined
1120 # in which case, we need to remove all metavalues for the metaname at the given (sub)section
1121 # Thereafter, we will finally be setting the overriding metavalue for this metaname
1122 if (!defined $prevmetavalue && !defined $metapos && $metamode eq "override") {
1123 # remove all values of $metaname metadata
1124 $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_xml_file), $metaname, undef, undef, $docid_secnum, $metamode);
1125 }
1126 # Edit the doc.xml file with the specified metadata name, value and position.
1127 # TODO: there is a potential problem here as this edit_doc_xml function
1128 # is assuming the simple doc.xml situation where there is only one Section and no SubSections.
1129 # Running import.pl -groupsize will cause this to have multiple sections in one doc.xml
1130
1131 # dxml_metadata method ignores metapos if metamode anything other than override
1132 $self->edit_doc_xml($gsdl_cgi,$doc_xml_filename,
1133 $metaname,$metavalue,$metapos,$metamode,$docid_secnum,$prevmetavalue);
1134
1135 # return 0; # return 0 for now to indicate no error
1136 return (defined $self->{'error_msg'}) ? 1 : 0;
1137}
1138
1139
1140sub set_archives_metadata
1141{
1142 my $self = shift @_;
1143
1144 my $username = $self->{'username'};
1145 my $collect = $self->{'collect'};
1146 my $gsdl_cgi = $self->{'gsdl_cgi'};
1147
1148 if ($baseaction::authentication_enabled) {
1149 # Ensure the user is allowed to edit this collection
1150 $self->authenticate_user($username, $collect);
1151 }
1152
1153 # Make sure the collection isn't locked by someone else
1154 $self->lock_collection($username, $collect);
1155
1156 $self->_set_archives_metadata(@_);
1157
1158 # Release the lock once it is done
1159 $self->unlock_collection($username, $collect);
1160}
1161
1162sub _set_archives_metadata_array
1163{
1164 my $self = shift @_;
1165
1166 my $collect = $self->{'collect'};
1167 my $gsdl_cgi = $self->{'gsdl_cgi'};
1168 my $site = $self->{'site'};
1169 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1170
1171 # look up additional args
1172
1173 my $infodbtype = $self->{'infodbtype'};
1174
1175 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1176
1177 my $json_str = $self->{'json'};
1178 my $doc_array = decode_json $json_str;
1179
1180
1181 my $global_status = 0;
1182 my $global_mess = "";
1183
1184 my @all_docids = ();
1185
1186 foreach my $doc_array_rec ( @$doc_array ) {
1187 my $status = -1;
1188 my $docid = $doc_array_rec->{'docid'};
1189
1190 push(@all_docids,$docid);
1191
1192 my $metaname = $doc_array_rec->{'metaname'};
1193 if(defined $metaname) {
1194
1195 my $metapos = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
1196
1197 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1198 my $metavalue = $doc_array_rec->{'metavalue'};
1199 my $prevmetavalue = $self->{'prevmetavalue'}; # to make this sub behave as _set_archives_metadata
1200
1201
1202 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1203 # make "accumulate" the default (less destructive, as it won't actually
1204 # delete any existing values)
1205 $metamode = "accumulate";
1206 }
1207
1208 $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,$docid,
1209 $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1210 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1211 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1212
1213 foreach my $metatable_rec ( @$metatable ) {
1214 $metaname = $metatable_rec->{'metaname'};
1215 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
1216 my $metapos = undef;
1217 my $prevmetavalue = undef;
1218 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1219
1220 foreach my $metavalue ( @$metavals ) {
1221 $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect,$infodbtype,
1222 $docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1223
1224 if($metamode eq "override") { # now, having overridden the metavalue for the first,
1225 # need to accumulate subsequent metavals for this metaname, else the just-assigned
1226 # metavalue for this metaname will be lost
1227 $metamode = "accumulate";
1228 }
1229 }
1230 }
1231 }
1232
1233 if ($status != 0) {
1234 # Catch error if set infodb entry failed
1235 $global_status = $status;
1236 $global_mess .= "Failed to set metadata key: $docid\n";
1237 $global_mess .= "Exit status: $status\n";
1238 $global_mess .= "System Error Message: $!\n";
1239 $global_mess .= "-" x 20 . "\n";
1240 }
1241 }
1242
1243 if ($global_status != 0) {
1244 $global_mess .= "PATH: $ENV{'PATH'}\n";
1245 $gsdl_cgi->generate_error($global_mess);
1246 }
1247 else {
1248 my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1249 $gsdl_cgi->generate_ok_message($mess);
1250 }
1251}
1252
1253sub set_archives_metadata_array
1254{
1255 my $self = shift @_;
1256
1257 my $username = $self->{'username'};
1258 my $collect = $self->{'collect'};
1259 my $gsdl_cgi = $self->{'gsdl_cgi'};
1260# my $gsdlhome = $self->{'gsdlhome'};
1261
1262 if ($baseaction::authentication_enabled) {
1263 # Ensure the user is allowed to edit this collection
1264 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1265 }
1266
1267 my $site = $self->{'site'};
1268 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1269
1270 $gsdl_cgi->checked_chdir($collect_dir);
1271
1272 # Obtain the collect dir
1273 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
1274
1275 # Make sure the collection isn't locked by someone else
1276 $self->lock_collection($username, $collect);
1277
1278 $self->_set_archives_metadata_array(@_);
1279
1280 # Release the lock once it is done
1281 $self->unlock_collection($username, $collect);
1282}
1283
1284sub _remove_archives_metadata
1285{
1286 my $self = shift @_;
1287
1288 my $collect = $self->{'collect'};
1289 my $gsdl_cgi = $self->{'gsdl_cgi'};
1290# my $gsdlhome = $self->{'gsdlhome'};
1291 my $infodbtype = $self->{'infodbtype'};
1292
1293 my $site = $self->{'site'};
1294
1295 # Obtain the collect and archive dir
1296 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1297
1298 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1299
1300 # look up additional args
1301 my ($docid, $docid_secnum) = ($self->{'d'} =~ m/^(.*?)(\..*)?$/);
1302
1303 my $metaname = $self->{'metaname'};
1304 my $metapos = $self->{'metapos'};
1305 my $metavalue = $self->{'metavalue'};
1306
1307 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
1308 $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/)); # necessary to force fallback to undef here
1309
1310 # if the user hasn't told us what to delete, not having given a metavalue or metapos,
1311 # default to deleting the first metavalue for the given metaname
1312 # Beware that if both metapos AND metavalue are defined, both matches (if any)
1313 # seem to get deleted in one single remove_archives_meta action invocation.
1314 # Similarly, if 2 identical metavalues for a metaname exist and that metavalue is being
1315 # deleted, both get deleted.
1316 if(!defined $metapos && !defined $metavalue) {
1317 $metapos = 0;
1318 }
1319
1320 my $metamode = $self->{'metamode'};
1321 $metamode = undef if(defined $metamode && ($metamode =~ m/^\s*$/));
1322
1323 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1324 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1325
1326 # This now stores the full pathname
1327 my $doc_filename = $doc_rec->{'doc-file'}->[0];
1328
1329 my $status = $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, $metavalue, $docid_secnum, $metamode);
1330# my $status = $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, undef, $docid_secnum);
1331
1332 if ($status == 0)
1333 {
1334 my $mess = "\nremove-archives-metadata successful: \nKey[$docid]\n";
1335 $mess .= " $metaname";
1336 $mess .= "->[$metapos]" if (defined $metapos);
1337 $mess .= " ($metavalue)" if (defined $metavalue);
1338 $gsdl_cgi->generate_ok_message($mess);
1339 }
1340 else
1341 {
1342 my $mess .= "Failed to remove archives metadata key: $docid\n";
1343 $mess .= "Exit status: $status\n";
1344 $mess .= "System Error Message: $!\n";
1345 $mess .= "-" x 20 . "\n";
1346
1347 $gsdl_cgi->generate_error($mess);
1348 }
1349
1350 #return $status; # in case calling functions have a use for this
1351}
1352
1353sub remove_archives_metadata
1354{
1355 my $self = shift @_;
1356
1357 my $username = $self->{'username'};
1358 my $collect = $self->{'collect'};
1359 my $gsdl_cgi = $self->{'gsdl_cgi'};
1360
1361 if ($baseaction::authentication_enabled)
1362 {
1363 # Ensure the user is allowed to edit this collection
1364 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1365 }
1366
1367 # Make sure the collection isn't locked by someone else
1368 $self->lock_collection($username, $collect);
1369
1370 $self->_remove_archives_metadata(@_);
1371
1372 # Release the lock once it is done
1373 $self->unlock_collection($username, $collect);
1374}
1375
1376sub remove_from_doc_xml
1377{
1378 my $self = shift @_;
1379 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metapos, $metavalue, $secid, $metamode) = @_;
1380
1381 my @start_rules = ('Section' => \&dxml_start_section);
1382
1383 # Set the call-back functions for the metadata tags
1384 my @rules =
1385 (
1386 _default => 'raw',
1387 'Metadata' => \&rfdxml_metadata
1388 );
1389
1390 my $parser = XML::Rules->new
1391 (
1392 start_rules => \@start_rules,
1393 rules => \@rules,
1394 style => 'filter',
1395 output_encoding => 'utf8',
1396# normalisespaces => 1, # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1397 stripspaces => 2|0|0 # ineffectual
1398 );
1399
1400 my $status = 0;
1401 my $xml_in = "";
1402 if (!open(MIN,"<$doc_xml_filename"))
1403 {
1404 $gsdl_cgi->generate_error("Unable to read in $doc_xml_filename: $!");
1405 $status = 1;
1406 }
1407 else
1408 {
1409 # Read them in
1410 my $line;
1411 while (defined ($line=<MIN>)) {
1412 $xml_in .= $line;
1413 }
1414 close(MIN);
1415
1416 # Filter with the call-back functions
1417 my $xml_out = "";
1418
1419 my $MOUT;
1420 if (!open($MOUT,">$doc_xml_filename")) {
1421 $gsdl_cgi->generate_error("Unable to write out to $doc_xml_filename: $!");
1422 $status = 1;
1423 }
1424 else {
1425 binmode($MOUT,":utf8");
1426 $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, secid => $secid, metamode => $metamode});
1427 close($MOUT);
1428 }
1429 }
1430 return $status;
1431}
1432
1433sub rfdxml_metadata
1434{
1435 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1436
1437 # For comparisons, toplevel section is indicated by ""
1438 my $curr_sec_num = $parser->{'parameters'}->{'curr_section_num'} || "";
1439 my $secid = $parser->{'parameters'}->{'secid'} || "";
1440
1441 if (!($secid eq $curr_sec_num))
1442 {
1443 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1444 return [$tagname => $attrHash];
1445 }
1446
1447 if ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
1448 {
1449 if (!defined $parser->{'parameters'}->{'poscount'})
1450 {
1451 $parser->{'parameters'}->{'poscount'} = 0;
1452 }
1453 else
1454 {
1455 $parser->{'parameters'}->{'poscount'}++;
1456 }
1457
1458 # if overriding (for set-meta) but no metapos, then clear all the meta for this metaname
1459 if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'}) &&(!defined $parser->{'parameters'}->{'metavalue'})) {
1460 return [];
1461 }
1462
1463 if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
1464 {
1465 return [];
1466 }
1467
1468 if ((defined $parser->{'parameters'}->{'metavalue'}) && ($parser->{'parameters'}->{'metavalue'} eq $attrHash->{'_content'}))
1469 {
1470 return [];
1471 }
1472 }
1473
1474 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1475 return [$tagname => $attrHash];
1476}
1477
1478sub mxml_metadata
1479{
1480 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1481 my $metaname = $parser->{'parameters'}->{'metaname'};
1482 my $metamode = $parser->{'parameters'}->{'metamode'};
1483
1484 # Report error if we don't see FileName tag before this
1485 die "Fatal Error: Unexpected metadata.xml structure. Undefined current_file, possibly encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1486
1487 # Don't do anything if we are not in the right FileSet
1488 my $file_regexp = $parser->{'parameters'}->{'current_file'};
1489 if ($file_regexp =~ /\.\*/) {
1490 # Only interested in a file_regexp if it specifies precisely one
1491 # file.
1492 # So, skip anything with a .* in it as it is too general
1493## print STDERR "@@@@ Skipping entry in metadata.xml where FileName=.* as it is too general\n";
1494 return [$tagname => $attrHash];
1495 }
1496 my $src_file = $parser->{'parameters'}->{'src_file'};
1497 if (!($src_file =~ /$file_regexp/)) {
1498 return [$tagname => $attrHash];
1499 }
1500## print STDERR "*** mxl metamode = $metamode\n";
1501
1502 # Find the right metadata tag and checks if we are going to override it
1503 my $name_attr = $attrHash->{'name'};
1504 if (($name_attr eq $metaname) && ($metamode eq "override")) {
1505
1506 # now metadata.xml functions need to keep track of metapos
1507 if (!defined $parser->{'parameters'}->{'poscount'})
1508 {
1509 $parser->{'parameters'}->{'poscount'} = 0;
1510 }
1511 else
1512 {
1513 $parser->{'parameters'}->{'poscount'}++;
1514 }
1515
1516 # If either the metapos or prevmetavalue is set,
1517 # get the value and override the current value
1518 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1519
1520 if(defined $parser->{'parameters'}->{'prevmetavalue'} && $parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'})
1521 {
1522 $attrHash->{'_content'} = $metavalue;
1523
1524 ## print STDERR "**** overriding metadata.xml\n";
1525
1526 # Don't want it to wipe out any other pieces of metadata
1527 $parser->{'parameters'}->{'metamode'} = "done";
1528 }
1529 elsif(defined $parser->{'parameters'}->{'metapos'} && $parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'})
1530 {
1531 $attrHash->{'_content'} = $metavalue;
1532 $parser->{'parameters'}->{'metamode'} = "done";
1533 }
1534 }
1535
1536 # mxml_description will process the metadata if metadata is accumulate,
1537 # or if we haven't found the metadata to override
1538
1539 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1540 return [$tagname => $attrHash];
1541}
1542
1543
1544sub mxml_description
1545{
1546 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1547 my $metamode = $parser->{'parameters'}->{'metamode'};
1548
1549 # Failed... Report error if we don't see FileName tag before this
1550 die "Fatal Error: Unexpected metadata.xml structure. Undefind current_file, possiblely encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1551
1552 # Don't do anything if we are not in the right FileSet
1553 my $file_regexp = $parser->{'parameters'}->{'current_file'};
1554 if ($file_regexp =~ m/\.\*/) {
1555 # Only interested in a file_regexp if it specifies precisely one
1556 # file.
1557 # So, skip anything with a .* in it as it is too general
1558 return [$tagname => $attrHash];
1559 }
1560 my $src_file = $parser->{'parameters'}->{'src_file'};
1561
1562 if (!($src_file =~ m/$file_regexp/)) {
1563 return [$tagname => $attrHash];
1564 }
1565
1566 # Accumulate the metadata block to the end of the description block
1567 # Note: This adds metadata block to all description blocks, so if there are
1568 # multiple FileSets, it will add to all of them
1569 if (($metamode eq "accumulate") || ($metamode eq "override")) {
1570
1571 # if metamode was "override" but get to here then it failed to
1572 # find an item to override, in which case it should append its
1573 # value to the end, just like the "accumulate" mode
1574
1575 if ($metamode eq "override") {
1576 print "No metadata value to override. Switching 'metamode' to accumulate\n";
1577 }
1578
1579 # tack a new metadata tag on to the end of the <Metadata>+ block
1580 my $metaname = $parser->{'parameters'}->{'metaname'};
1581 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1582
1583 my $metadata_attr = { '_content' => $metavalue,
1584 'name' => $metaname,
1585 'mode' => "accumulate" };
1586
1587 my $append_metadata = [ "Metadata" => $metadata_attr ];
1588 my $description_content = $attrHash->{'_content'};
1589
1590## print STDERR "*** appending to metadata.xml\n";
1591
1592 # append the new metadata element to the end of the current
1593 # content contained inside this tag
1594 if (ref($description_content) eq "") {
1595 # => string or numeric literal
1596 # this is caused by a <Description> block has no <Metadata> child elements
1597 # => set up an empty array in '_content'
1598 $attrHash->{'_content'} = [ "\n" ];
1599 $description_content = $attrHash->{'_content'};
1600 }
1601
1602 push(@$description_content," ", $append_metadata ,"\n ");
1603 $parser->{'parameters'}->{'metamode'} = "done";
1604 }
1605
1606 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1607 return [$tagname => $attrHash];
1608}
1609
1610
1611sub mxml_fileset
1612{
1613 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1614
1615 # Initilise the current_file
1616 # Note: According to http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd
1617 # FileName tag must come before Description tag
1618 $parser->{'parameters'}->{'current_file'} = "";
1619
1620 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1621 return [$tagname => $attrHash];
1622}
1623
1624sub mxml_directorymetadata
1625{
1626 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1627
1628 # if we haven't processed the metadata when we reach the end of metadata.xml
1629 # it's because there's no particular FileSet element whose FileName matched
1630 # In which case, add a new FileSet for this FileName
1631 my $metamode = $parser->{'parameters'}->{'metamode'};
1632 if($metamode ne "done") {
1633
1634 if ($metamode eq "override") {
1635 print "No metadata value to override. Switching 'metamode' to accumulate\n";
1636 }
1637
1638 # If we get to here and metamode is override, this means there
1639 # was no existing value to overide => treat as an append operation
1640
1641 # Create a new FileSet element and append to DirectoryMetadata
1642 # <FileSet>
1643 # <FileName>src_file</FileName>
1644 # <Description>
1645 # <Metadata mode="" name="">metavalue</Metadata>
1646 # </Description>
1647 # </FileSet>
1648 my $src_file = $parser->{'parameters'}->{'src_file'};
1649 my $metaname = $parser->{'parameters'}->{'metaname'};
1650 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1651 my $metadata_attr = {
1652 '_content' => $metavalue,
1653 'name' => $metaname,
1654 'mode' => "accumulate"
1655 };
1656 my $append_metadata = [ "Metadata" => $metadata_attr ];
1657 my $description_attr = { '_content' => [ "\n\t\t ", $append_metadata, "\n\t\t"] };
1658 my $description_element = [ "Description" => $description_attr ];
1659
1660 #_content is not an attribute, it's special and holds the children of this element
1661 # including the textnode value embedded in this element if any.
1662 my $filename_attr = {'_content' => $src_file};
1663 my $filename_element = [ "FileName" => $filename_attr ];
1664
1665 my $fileset_attr = {};
1666 $fileset_attr->{'_content'} = [ "\n\t\t", $filename_element,"\n\t\t",$description_element ,"\n\t" ];
1667 my $fileset = [ "FileSet" => $fileset_attr ]; #my $fileset = [ "FileSet" => {} ];
1668
1669
1670 # get children of dirmeta, and push the new FileSet element onto it
1671 print "Appending metadata to metadata.xml\n";
1672 my $dirmeta_content = $attrHash->{'_content'};
1673 if (ref($dirmeta_content)) {
1674 # got some existing interesting nested content
1675 #push(@$dirmeta_content, " ", $fileset ,"\n ");
1676 push(@$dirmeta_content, "\t", $fileset ,"\n");
1677 }
1678 else {
1679 #description_content is most likely a string such as "\n"
1680 #$attrHash->{'_content'} = [$dirmeta_content, " ", $fileset ,"\n" ];
1681 $attrHash->{'_content'} = [$dirmeta_content, "\t", $fileset ,"\n" ];
1682 }
1683
1684 $parser->{'parameters'}->{'metamode'} = "done";
1685 }
1686 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1687 return [$tagname => $attrHash];
1688}
1689
1690
1691sub edit_metadata_xml
1692{
1693 my $self = shift @_;
1694 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $metamode, $src_file, $prevmetavalue) = @_;
1695
1696 # Set the call-back functions for the metadata tags
1697 my @rules =
1698 ( _default => 'raw',
1699 'FileName' => \&mxml_filename,
1700 'Metadata' => \&mxml_metadata,
1701 'Description' => \&mxml_description,
1702 'FileSet' => \&mxml_fileset,
1703 'DirectoryMetadata' => \&mxml_directorymetadata);
1704
1705 # use XML::Rules to add it in (read in and out again)
1706 my $parser = XML::Rules->new(rules => \@rules,
1707 style => 'filter',
1708 output_encoding => 'utf8',
1709 stripspaces => 2|0|0); # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1710
1711 if (!-e $metadata_xml_filename) {
1712
1713 if (open(MOUT,">$metadata_xml_filename")) {
1714
1715 my $src_file_re = &util::filename_to_regex($src_file);
1716 # shouldn't the following also be in the above utility routine??
1717 # $src_file_re =~ s/\./\\./g;
1718
1719 print MOUT "<?xml version=\"1.0\"?>\n";
1720 print MOUT "<DirectoryMetadata>\n";
1721 print MOUT " <FileSet>\n";
1722 print MOUT " <FileName>$src_file_re</FileName>\n";
1723 print MOUT " <Description>\n";
1724 print MOUT " </Description>\n";
1725 print MOUT " </FileSet>\n";
1726 print MOUT "</DirectoryMetadata>\n";
1727
1728 close(MOUT);
1729 }
1730 else {
1731 $gsdl_cgi->generate_error("Unable to create $metadata_xml_filename: $!");
1732 }
1733 }
1734
1735
1736 my $xml_in = "";
1737 if (!open(MIN,"<$metadata_xml_filename")) {
1738 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
1739 }
1740 else {
1741 # Read them in
1742 my $line;
1743 while (defined ($line=<MIN>)) {
1744 $xml_in .= $line;
1745 }
1746 close(MIN);
1747
1748 # Filter with the call-back functions
1749 my $xml_out = "";
1750
1751 my $MOUT;
1752 if (!open($MOUT,">$metadata_xml_filename")) {
1753 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
1754 }
1755 else {
1756 binmode($MOUT,":utf8");
1757
1758 # Some wise person please find out how to keep the DTD and encode lines in after it gets filtered by this XML::Rules
1759 # At the moment, I will just hack it!
1760 #my $header_with_utf8_dtd = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
1761 #$header_with_utf8_dtd .= "<!DOCTYPE DirectoryMetadata SYSTEM \"http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd\">";
1762 #$xml_out =~ s/\<\?xml\sversion\=\"1.0\"\?\>/$header_with_utf8_dtd/;
1763 #print MOUT $xml_out;
1764
1765 $parser->filter($xml_in, $MOUT, { metaname => $metaname,
1766 metapos => $metapos,
1767 metavalue => $metavalue,
1768 metamode => $metamode,
1769 src_file => $src_file,
1770 prevmetavalue => $prevmetavalue,
1771 current_file => undef} );
1772 close($MOUT);
1773 }
1774 }
1775}
1776
1777
1778sub set_import_metadata
1779{
1780 my $self = shift @_;
1781
1782 my $username = $self->{'username'};
1783 my $collect = $self->{'collect'};
1784 my $gsdl_cgi = $self->{'gsdl_cgi'};
1785
1786 if ($baseaction::authentication_enabled) {
1787 # Ensure the user is allowed to edit this collection
1788 $self->authenticate_user($username, $collect);
1789 }
1790
1791 # Make sure the collection isn't locked by someone else
1792 $self->lock_collection($username, $collect);
1793
1794 $self->_set_import_metadata(@_);
1795
1796 # Release the lock once it is done
1797 $self->unlock_collection($username, $collect);
1798
1799}
1800
1801sub set_import_metadata_array
1802{
1803 my $self = shift @_;
1804
1805 my $username = $self->{'username'};
1806 my $collect = $self->{'collect'};
1807 my $gsdl_cgi = $self->{'gsdl_cgi'};
1808# my $gsdlhome = $self->{'gsdlhome'};
1809
1810 if ($baseaction::authentication_enabled) {
1811 # Ensure the user is allowed to edit this collection
1812 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1813 }
1814
1815 my $site = $self->{'site'};
1816 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1817
1818 $gsdl_cgi->checked_chdir($collect_dir);
1819
1820 # Make sure the collection isn't locked by someone else
1821 $self->lock_collection($username, $collect);
1822
1823 $self->_set_import_metadata_array(@_);
1824
1825 # Release the lock once it is done
1826 $self->unlock_collection($username, $collect);
1827
1828}
1829
1830
1831sub _set_import_metadata_array
1832{
1833 my $self = shift @_;
1834
1835 my $collect = $self->{'collect'};
1836 my $gsdl_cgi = $self->{'gsdl_cgi'};
1837
1838 my $site = $self->{'site'};
1839 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1840
1841 # look up additional args
1842
1843 my $infodbtype = $self->{'infodbtype'};
1844
1845 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1846 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1847
1848 my $json_str = $self->{'json'};
1849 my $doc_array = decode_json $json_str;
1850
1851 my $global_status = 0;
1852 my $global_mess = "";
1853
1854 my @all_docids = ();
1855
1856 foreach my $doc_array_rec ( @$doc_array )
1857 {
1858 my $status = -1;
1859 my $docid = $doc_array_rec->{'docid'};
1860
1861 my ($docid_root,$docid_secnum);
1862 if(defined $docid) {
1863 ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
1864 # as yet no support for setting subsection metadata in metadata.xml
1865 if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
1866 $gsdl_cgi->generate_message("*** docid: $docid. No support yet for setting import metadata at subsections level.\n");
1867 next; # skip this docid in for loop
1868 }
1869 }
1870
1871 push(@all_docids,$docid); # docid_root rather
1872
1873 my $metaname = $doc_array_rec->{'metaname'};
1874 if (defined $metaname) {
1875 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1876 my $metavalue = $doc_array_rec->{'metavalue'};
1877 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
1878
1879 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1880 # make "accumulate" the default (less destructive, as it won't actually
1881 # delete any existing values)
1882 $metamode = "accumulate";
1883 }
1884
1885 # adding metapos and prevmetavalue support to import_metadata subroutines
1886 my $metapos = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
1887 my $prevmetavalue = $self->{'prevmetavalue'};
1888
1889 $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
1890
1891 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1892 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1893
1894 foreach my $metatable_rec ( @$metatable ) {
1895 $metaname = $metatable_rec->{'metaname'};
1896 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
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 # No support for metapos and prevmetavalue in the JSON metatable substructure
1904 my $metapos = undef;
1905 my $prevmetavalue = undef;
1906 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1907
1908 foreach my $metavalue ( @$metavals ) {
1909 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
1910
1911 $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
1912 if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
1913 # need to accumulate subsequent metavals for this metaname, else the just-assigned
1914 # metavalue for this metaname will be lost
1915 $metamode = "accumulate";
1916 }
1917 }
1918 }
1919 }
1920 }
1921
1922 # always a success message
1923 my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1924 $gsdl_cgi->generate_ok_message($mess);
1925}
1926
1927# always returns true (1)
1928sub set_import_metadata_entry
1929{
1930 my $self = shift @_;
1931 my ($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue, $collect, $collect_dir) = @_;
1932
1933 my $info_mess = <<RAWEND;
1934****************************
1935 set_import_metadata_entry()
1936****************************
1937RAWEND
1938
1939 $info_mess .= " collect_dir = $collect_dir\n" if defined($collect_dir);
1940 $info_mess .= " collect = $collect\n" if defined($collect);
1941 $info_mess .= " infodbtype = $infodbtype\n" if defined($infodbtype);
1942 $info_mess .= " arcinfo_doc_filename = $arcinfo_doc_filename\n" if defined($arcinfo_doc_filename);
1943 $info_mess .= " docid = $docid\n" if defined($docid);
1944 $info_mess .= " metaname = $metaname\n" if defined($metaname);
1945 $info_mess .= " metapos = $metapos\n" if defined($metapos);
1946 $info_mess .= " metavalue = $metavalue\n" if defined($metavalue);
1947 $info_mess .= " metamode = $metamode\n" if defined($metamode);
1948 $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1949
1950 $info_mess .= "****************************\n";
1951
1952 $gsdl_cgi->generate_message($info_mess);
1953
1954 # import works with metadata.xml which can have inherited metadata
1955 # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
1956 # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
1957 # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
1958 # what they're doing if they provide a metapos.
1959 if(defined $metapos) {
1960 print STDERR "@@@@ WARNING: metapos defined.\n";
1961 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
1962 }
1963
1964 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
1965 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
1966 my $metadata_xml_file;
1967 my $import_filename = undef;
1968
1969 if (defined $docid) {
1970 # my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1971 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1972
1973 # This now stores the full pathname
1974 $import_filename = $doc_rec->{'src-file'}->[0];
1975 $import_filename = &util::placeholders_to_abspath($import_filename);
1976
1977 } else { # only for set_import_meta, not the case when calling method is set_import_metadata_array
1978 # as the array version of the method doesn't support the -f parameter yet
1979 my $import_file = $self->{'f'};
1980 $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
1981 }
1982
1983 # figure out correct metadata.xml file [?]
1984 # Assuming the metadata.xml file is next to the source file
1985 # Note: This will not work if it is using the inherited metadata from the parent folder
1986 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
1987 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
1988
1989 # If we're overriding everything, then $prevmetavalue=undefined and
1990 # $metamode=override combined with $metapos=undefined
1991 # in which case we need to remove all metavalues for the metaname at the given (sub)section
1992 # Thereafter, we will finally be able to set the overriding metavalue for this metaname
1993 if(!defined $prevmetavalue && !defined $metapos && $metamode eq "override") {
1994## print STDERR "@@@ REMOVING all import metadata for $metaname\n";
1995 $self->remove_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, undef, $import_tailname, $metamode); # we're removing all values, so metavalue=undef
1996
1997 }
1998
1999 # Edit the metadata.xml
2000 # Modified by Jeffrey from DL Consulting
2001 # Handle the case where there is one metadata.xml file for multiple FileSets
2002 # The XML filter needs to know whether it is in the right FileSet
2003 # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2004 # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2005 $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2006 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2007 #return 0;
2008 return $metadata_xml_filename;
2009}
2010
2011sub _remove_import_metadata
2012{
2013 my $self = shift @_;
2014
2015 my $collect = $self->{'collect'};
2016 my $gsdl_cgi = $self->{'gsdl_cgi'};
2017# my $gsdlhome = $self->{'gsdlhome'};
2018 my $infodbtype = $self->{'infodbtype'};
2019
2020 # Obtain the collect dir
2021 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2022 my $site = $self->{'site'};
2023 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2024
2025 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2026 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2027
2028 # look up additional args
2029 my $docid = $self->{'d'};
2030 if ((!defined $docid) || ($docid =~ m/^\s*$/))
2031 {
2032 $gsdl_cgi->generate_error("No docid (d=...) specified.\n");
2033 }
2034
2035 my $metaname = $self->{'metaname'};
2036 my $metapos = $self->{'metapos'};
2037 my $metavalue = $self->{'metavalue'};
2038
2039 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
2040 $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/));
2041
2042 if(defined $metavalue) { # metavalue is now a compulsory arg for remove_import_metadata()
2043 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2044 } elsif (!defined $metapos) { # if given no metavalue or metapos to delete, default to deleting the 1st
2045 $metapos = 0;
2046 }
2047 my $metamode = $self->{'metamode'};
2048 $metamode = undef if(defined $metamode && ($metamode =~ m/^\s*$/));
2049
2050 # import works with metadata.xml which can have inherited metadata
2051 # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
2052 # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
2053 # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
2054 # what they're doing if they provide a metapos.
2055 if(defined $metapos) {
2056 print STDERR "@@@@ WARNING: metapos defined.\n";
2057 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
2058 }
2059
2060 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2061 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2062 my $metadata_xml_file;
2063 my $import_filename = undef;
2064 if (defined $docid)
2065 {
2066 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2067 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2068
2069 # This now stores the full pathname
2070 $import_filename = $doc_rec->{'src-file'}->[0];
2071 $import_filename = &util::placeholders_to_abspath($import_filename);
2072 }
2073
2074 if((!defined $import_filename) || ($import_filename =~ m/^\s*$/))
2075 {
2076 $gsdl_cgi->generate_error("There is no metadata\n");
2077 }
2078
2079 # figure out correct metadata.xml file [?]
2080 # Assuming the metadata.xml file is next to the source file
2081 # Note: This will not work if it is using the inherited metadata from the parent folder
2082 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2083 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2084
2085 $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
2086
2087 my $mess = "remove-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
2088 $mess .= " $metaname";
2089 $mess .= " = $metavalue\n";
2090
2091 $gsdl_cgi->generate_ok_message($mess);
2092
2093 #return $status; # in case calling functions have a use for this
2094}
2095
2096sub remove_import_metadata
2097{
2098 my $self = shift @_;
2099
2100 my $username = $self->{'username'};
2101 my $collect = $self->{'collect'};
2102 my $gsdl_cgi = $self->{'gsdl_cgi'};
2103
2104 if ($baseaction::authentication_enabled) {
2105 # Ensure the user is allowed to edit this collection
2106 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2107 }
2108
2109 # Make sure the collection isn't locked by someone else
2110 $self->lock_collection($username, $collect);
2111
2112 $self->_remove_import_metadata(@_);
2113
2114 # Release the lock once it is done
2115 $self->unlock_collection($username, $collect);
2116
2117}
2118
2119sub remove_from_metadata_xml
2120{
2121 my $self = shift @_;
2122 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $src_file, $metamode) = @_;
2123 # metamode generally has no meaning for removing meta, but is used by set_meta
2124 # when overriding all metavals for a metaname, in which case remove_meta is called with metamode
2125
2126 # Set the call-back functions for the metadata tags
2127 my @rules =
2128 (
2129 _default => 'raw',
2130 'Metadata' => \&rfmxml_metadata,
2131 'FileName' => \&mxml_filename
2132 );
2133
2134 my $parser = XML::Rules->new
2135 (
2136 rules => \@rules,
2137 style => 'filter',
2138 output_encoding => 'utf8',
2139 #normalisespaces => 1,
2140 stripspaces => 2|0|0 # ineffectual
2141 );
2142
2143 my $xml_in = "";
2144 if (!open(MIN,"<$metadata_xml_filename"))
2145 {
2146 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
2147 }
2148 else
2149 {
2150 # Read them in
2151 my $line;
2152 while (defined ($line=<MIN>)) {
2153 $xml_in .= $line;
2154 }
2155 close(MIN);
2156
2157 # Filter with the call-back functions
2158 my $xml_out = "";
2159
2160 my $MOUT;
2161 if (!open($MOUT,">$metadata_xml_filename")) {
2162 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
2163 }
2164 else {
2165 binmode($MOUT,":utf8");
2166 $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, src_file => $src_file, metamode => $metamode, current_file => undef});
2167 close($MOUT);
2168 }
2169 }
2170}
2171
2172sub rfmxml_metadata
2173{
2174 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2175
2176 # metadata.xml does not handle subsections
2177
2178 # since metadata.xml now has to deal with metapos, we keep track of the metadata position
2179 if (($parser->{'parameters'}->{'src_file'} eq $parser->{'parameters'}->{'current_file'})
2180 && $parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
2181 {
2182 if (!defined $parser->{'parameters'}->{'poscount'})
2183 {
2184 $parser->{'parameters'}->{'poscount'} = 0;
2185 }
2186 else
2187 {
2188 $parser->{'parameters'}->{'poscount'}++;
2189 }
2190
2191 # if overriding but no metapos, then clear all the meta for this metaname
2192 if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'}) && (!defined $parser->{'parameters'}->{'metavalue'})) {
2193 return [];
2194 }
2195
2196 if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
2197 {
2198 return [];
2199 }
2200 if ((defined $parser->{'parameters'}->{'metavalue'}) && ($attrHash->{'_content'} eq $parser->{'parameters'}->{'metavalue'}))
2201 {
2202 return [];
2203 }
2204 }
2205
2206 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2207 return [$tagname => $attrHash];
2208}
2209
2210sub _remove_live_metadata
2211{
2212 my $self = shift @_;
2213
2214 my $collect = $self->{'collect'};
2215 my $gsdl_cgi = $self->{'gsdl_cgi'};
2216# my $gsdlhome = $self->{'gsdlhome'};
2217 my $infodbtype = $self->{'infodbtype'};
2218
2219 # Obtain the collect dir
2220 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2221 my $site = $self->{'site'};
2222 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2223
2224
2225 # look up additional args
2226 my $docid = $self->{'d'};
2227 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2228 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2229 }
2230
2231 # Generate the dbkey
2232 my $metaname = $self->{'metaname'};
2233 my $dbkey = "$docid.$metaname";
2234
2235 # To people who know $collect_tail please add some comments
2236 # Obtain the live gdbm_db path
2237 my $collect_tail = $collect;
2238 $collect_tail =~ s/^.*[\/|\\]//;
2239 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2240 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
2241
2242 # Remove the key
2243 my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\"";
2244 my $status = system($cmd);
2245 if ($status != 0) {
2246 # Catch error if gdbmdel failed
2247 my $mess = "Failed to set metadata key: $dbkey\n";
2248
2249 $mess .= "PATH: $ENV{'PATH'}\n";
2250 $mess .= "cmd = $cmd\n";
2251 $mess .= "Exit status: $status\n";
2252 $mess .= "System Error Message: $!\n";
2253
2254 $gsdl_cgi->generate_error($mess);
2255 }
2256 else {
2257 $gsdl_cgi->generate_ok_message("DB remove successful: Key[$metaname]");
2258 }
2259
2260}
2261
2262sub remove_live_metadata
2263{
2264 my $self = shift @_;
2265
2266 my $username = $self->{'username'};
2267 my $collect = $self->{'collect'};
2268 my $gsdl_cgi = $self->{'gsdl_cgi'};
2269 my $gsdlhome = $self->{'gsdlhome'};
2270
2271 if ($baseaction::authentication_enabled) {
2272 # Ensure the user is allowed to edit this collection
2273 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2274 }
2275
2276 # Make sure the collection isn't locked by someone else
2277 $self->lock_collection($username, $collect);
2278
2279 $self->_remove_live_metadata(@_);
2280
2281 $self->unlock_collection($username, $collect);
2282}
2283
2284sub remove_metadata
2285{
2286 my $self = shift @_;
2287
2288 my $where = $self->{'where'};
2289 if(!$where || ($where =~ m/^\s*$/)) {
2290 $self->remove_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
2291 return;
2292 }
2293
2294 my $username = $self->{'username'};
2295 my $collect = $self->{'collect'};
2296 my $gsdl_cgi = $self->{'gsdl_cgi'};
2297
2298 if ($baseaction::authentication_enabled) {
2299 # Ensure the user is allowed to edit this collection
2300 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2301 }
2302
2303 # Make sure the collection isn't locked by someone else
2304 $self->lock_collection($username, $collect);
2305
2306 # check which directories need to be processed, specified in $where as
2307 # any combination of import|archives|index|live
2308 if($where =~ m/import/) {
2309 $self->_remove_import_metadata(@_);
2310 }
2311 if($where =~ m/archives/) {
2312 $self->_remove_archives_metadata(@_);
2313 }
2314 if($where =~ m/index/) {
2315 $self->_remove_index_metadata(@_);
2316 }
2317
2318 # Release the lock once it is done
2319 $self->unlock_collection($username, $collect);
2320}
2321
2322# the internal version, without authentication
2323sub _remove_index_metadata
2324{
2325 my $self = shift @_;
2326
2327 my $collect = $self->{'collect'};
2328 my $gsdl_cgi = $self->{'gsdl_cgi'};
2329# my $gsdlhome = $self->{'gsdlhome'};
2330 my $infodbtype = $self->{'infodbtype'};
2331
2332 # Obtain the collect dir
2333 my $site = $self->{'site'};
2334 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2335 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2336
2337 # look up additional args
2338 my $docid = $self->{'d'};
2339 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2340 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2341 }
2342 my $metaname = $self->{'metaname'};
2343 my $metapos = $self->{'metapos'};
2344 my $metavalue = $self->{'metavalue'};
2345
2346 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
2347 $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/)); # necessary to force fallback to undef here
2348
2349 # To people who know $collect_tail please add some comments
2350 # -> In collection groups, I think collect_tailname is the subcollection name,
2351 # e.g. colgroup-name/col-tail-name
2352 # Obtain the path to the database
2353 my $collect_tail = $collect;
2354 $collect_tail =~ s/^.*[\/|\\]//;
2355 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2356 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2357
2358 # Read the docid entry
2359 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2360
2361 # Check to make sure the key does exist
2362 if (!defined ($doc_rec->{$metaname})) {
2363 $gsdl_cgi->generate_error("No metadata field \"" . $metaname . "\" in the specified document: [" . $docid . "]");
2364 }
2365
2366 # Obtain the specified metadata pos
2367 # if no metavalue or metapos to delete, default to deleting the 1st value for the metaname
2368 if(!defined $metapos && !defined $metavalue) {
2369 $metapos = 0;
2370 }
2371
2372
2373 # consider check key is defined before deleting?
2374 # Loop through the metadata array and ignore the specified position
2375 my $filtered_metadata = [];
2376 my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}});
2377 for (my $i=0; $i<$num_metadata_vals; $i++) {
2378 my $metaval = shift(@{$doc_rec->{$metaname}});
2379
2380 if (!defined $metavalue && $i != $metapos) {
2381 push(@$filtered_metadata,$metaval);
2382 }
2383
2384 if(defined $metavalue && !($metavalue eq $metaval))
2385 {
2386 push(@$filtered_metadata,$metaval);
2387 }
2388 }
2389 $doc_rec->{$metaname} = $filtered_metadata;
2390
2391 ## Use the dbutil set_entry method instead of assuming the database is gdbm
2392 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2393
2394 if ($status != 0) {
2395 my $mess = "Failed to set metadata key: $docid\n";
2396
2397 $mess .= "PATH: $ENV{'PATH'}\n";
2398 $mess .= "Exit status: $status\n";
2399 $mess .= "System Error Message: $!\n";
2400
2401 $gsdl_cgi->generate_error($mess);
2402 }
2403 else {
2404 my $mess = "DB set (with item deleted) successful: Key[$docid]\n";
2405 $mess .= " $metaname";
2406 $mess .= "->[$metapos]" if (defined $metapos);
2407 $mess .= " ($metavalue)" if (defined $metavalue);
2408
2409 $gsdl_cgi->generate_ok_message($mess);
2410 }
2411
2412 #return $status; # in case calling functions have a use for this
2413}
2414
2415sub remove_index_metadata
2416{
2417 my $self = shift @_;
2418
2419 my $username = $self->{'username'};
2420 my $collect = $self->{'collect'};
2421 my $gsdl_cgi = $self->{'gsdl_cgi'};
2422# my $gsdlhome = $self->{'gsdlhome'};
2423
2424 if ($baseaction::authentication_enabled) {
2425 # Ensure the user is allowed to edit this collection
2426 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2427 }
2428
2429 # Obtain the collect dir
2430 my $site = $self->{'site'};
2431 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2432 ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2433
2434 # Make sure the collection isn't locked by someone else
2435 $self->lock_collection($username, $collect);
2436
2437 $self->_remove_index_metadata(@_);
2438
2439 # Release the lock once it is done
2440 $self->unlock_collection($username, $collect);
2441}
2442
2443
2444# Was trying to reused the codes, but the functions need to be broken
2445# down more before they can be reused, otherwise there will be too
2446# much overhead and duplicate process...
2447sub insert_metadata
2448{
2449 my $self = shift @_;
2450
2451 my $username = $self->{'username'};
2452 my $collect = $self->{'collect'};
2453 my $gsdl_cgi = $self->{'gsdl_cgi'};
2454 my $gsdlhome = $self->{'gsdlhome'};
2455 my $infodbtype = $self->{'infodbtype'};
2456
2457 # If the import metadata and gdbm database have been updated, we
2458 # need to insert some notification to warn user that the the text
2459 # they see at the moment is not indexed and require a rebuild.
2460 my $rebuild_pending_macro = "_rebuildpendingmessage_";
2461
2462 if ($baseaction::authentication_enabled) {
2463 # Ensure the user is allowed to edit this collection
2464 $self->authenticate_user($username, $collect);
2465 }
2466
2467 # Obtain the collect and archive dir
2468 my $site = $self->{'site'};
2469 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2470 ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2471 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2472
2473 # Make sure the collection isn't locked by someone else
2474 $self->lock_collection($username, $collect);
2475
2476 # Check additional args
2477 my $docid = $self->{'d'};
2478 if (!defined($docid) || ($docid =~ m/^\s*$/)) {
2479 $gsdl_cgi->generate_error("No document id is specified: d=...");
2480 }
2481 my $metaname = $self->{'metaname'};
2482 if (!defined($metaname) || ($metaname =~ m/^\s*$/)) {
2483 $gsdl_cgi->generate_error("No metaname is specified: metadataname=...");
2484 }
2485 my $metavalue = $self->{'metavalue'};
2486 if (!defined($metavalue) || ($metavalue =~ m/^\s*$/)) {
2487 $gsdl_cgi->generate_error("No metavalue or empty metavalue is specified: metadataname=...");
2488 }
2489 # make "accumulate" the default (less destructive, as it won't actually
2490 # delete any existing values)
2491 my $metamode = "accumulate";
2492
2493 # metapos/prevmetavalue were never before used in this subroutine, so set them to undefined
2494 my $metapos = undef;
2495 my $prevmetavalue = undef;
2496
2497 #=======================================================================#
2498 # set_import_metadata [START]
2499 #=======================================================================#
2500 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2501 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2502 my $metadata_xml_file;
2503 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2504 my $archive_doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2505
2506 # This now stores the full pathname
2507 my $import_filename = $archive_doc_rec->{'src-file'}->[0];
2508 $import_filename = &util::placeholders_to_abspath($import_filename);
2509
2510 # figure out correct metadata.xml file [?]
2511 # Assuming the metadata.xml file is next to the source file
2512 # Note: This will not work if it is using the inherited metadata from the parent folder
2513 my ($import_tailname, $import_dirname)
2514 = File::Basename::fileparse($import_filename);
2515 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2516
2517 # Shane's escape characters
2518 $metavalue = pack "U0C*", unpack "C*", $metavalue;
2519 $metavalue =~ s/\,/&#44;/g;
2520 $metavalue =~ s/\:/&#58;/g;
2521 $metavalue =~ s/\|/&#124;/g;
2522 $metavalue =~ s/\(/&#40;/g;
2523 $metavalue =~ s/\)/&#41;/g;
2524 $metavalue =~ s/\[/&#91;/g;
2525 $metavalue =~ s/\\/&#92;/g;
2526 $metavalue =~ s/\]/&#93;/g;
2527 $metavalue =~ s/\{/&#123;/g;
2528 $metavalue =~ s/\}/&#125;/g;
2529 $metavalue =~ s/\"/&#34;/g;
2530 $metavalue =~ s/\`/&#96;/g;
2531 $metavalue =~ s/\n/_newline_/g;
2532
2533 # Edit the metadata.xml
2534 # Modified by Jeffrey from DL Consulting
2535 # Handle the case where there is one metadata.xml file for multiple FileSets
2536 # The XML filter needs to know whether it is in the right FileSet
2537 # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2538 # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2539 $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2540 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2541 #=======================================================================#
2542 # set_import_metadata [END]
2543 #=======================================================================#
2544
2545
2546 #=======================================================================#
2547 # set_metadata (accumulate version) [START]
2548 #=======================================================================#
2549 # To people who know $collect_tail please add some comments
2550 # Obtain path to the database
2551 my $collect_tail = $collect;
2552 $collect_tail =~ s/^.*[\/|\\]//;
2553 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2554 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2555
2556 # Read the docid entry
2557 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2558
2559 # Protect the quotes
2560 $metavalue =~ s/\"/\\\"/g;
2561
2562 # Adds the pending macro
2563 my $macro_metavalue = $rebuild_pending_macro . $metavalue;
2564
2565 # If the metadata doesn't exist, create a new one
2566 if (!defined($doc_rec->{$metaname})){
2567 $doc_rec->{$metaname} = [ $macro_metavalue ];
2568 }
2569 # Else, let's acculumate the values
2570 else {
2571 push(@{$doc_rec->{$metaname}},$macro_metavalue);
2572 }
2573
2574 ## Use the dbutil set_entry method instead of assuming the database is gdbm
2575 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2576
2577 if ($status != 0) {
2578 # Catch error if gdbmget failed
2579 my $mess = "Failed to set metadata key: $docid\n";
2580
2581 $mess .= "PATH: $ENV{'PATH'}\n";
2582 $mess .= "Exit status: $status\n";
2583 $mess .= "System Error Message: $!\n";
2584
2585 $gsdl_cgi->generate_error($mess);
2586 }
2587 else {
2588 my $mess = "insert-metadata successful: Key[$docid]\n";
2589 $mess .= " [In metadata.xml] $metaname";
2590 $mess .= " = $metavalue\n";
2591 $mess .= " [In database] $metaname";
2592 $mess .= " = $macro_metavalue\n";
2593 $mess .= " The new text has not been indexed, rebuilding collection is required\n";
2594 $gsdl_cgi->generate_ok_message($mess);
2595 }
2596 #=======================================================================#
2597 # set_metadata (accumulate version) [END]
2598 #=======================================================================#
2599
2600 # Release the lock once it is done
2601 $self->unlock_collection($username, $collect);
2602}
2603
2604# not returning 1; here since this file is conditionally included by metadataction.pm
2605# and not otherwise meant to be used on its own
2606
Note: See TracBrowser for help on using the repository browser.