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

Last change on this file since 38193 was 38193, checked in by anupama, 8 months ago
  1. Added remove_metadata_array methods: general one that calls the others, index, live, import and archives. But as I'm not sure how live is supposed to work, I just based it on the behaviour of set_live_metadata_array and remove_live_metadata. 2. Refactored remove_x_metadata to call remove_x_metadta_entry, so that the remove_x_metadata_array methods can call the latter too, as set_metadata_array methods call set_metadata_entry methods. 3. Some things I'm not too sure off, such as why metamode still exists for remove_import and remove_archives. I can see that rfmxml (remove from file metadata) uses it when set_import_metadata or set_archives_metadata is called with metamode override but no metapos or metavalue defined to set, in which case it empties all values for a given metaname, setting that metaname to an empty array. But remove_import_metadata and remove_archives_metadata always default to metapos=0 for safety reasons when metapos and metavalue is not defined, and I would like to keep that behaviour for remove_meta (and not change the existing behaviour for set_meta which also makes sense), but this then still leaves the question of what metamode means for remove_import_meta and remove_archives_meta. I've left the code as is, it doesn't really have any effect at present regardless of whether metamode is set to accumulate or override since metapos will always be set to 0 at least. Remove_import_meta_array and remove_archives_meta_array follow existing remove_meta code for import and archives in this: calling the same underlying remove_meta_entry function for import/archives. So if we decide to change the behaviour there in future, it will change it universally for remove_import and remove_archives methods.
File size: 133.3 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;
39use cgiactions::metadataactioncommon;
40
41use dbutil;
42use ghtml;
43
44use JSON;
45
46# convenient to have shorter version around
47my $FLDV_HISTORY_DIR = $metadataactioncommon::FLDV_HISTORY_DIR;
48
49$metadataaction::modmeta_action_table = #OR: our $modmeta_action_table =
50{
51 #SET METHODS
52 "set-live-metadata" => {
53 'compulsory-args' => [ "d", "metaname", "metavalue" ],
54 'optional-args' => [ ] },
55
56 "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
57 'compulsory-args' => [ "metaname", "metavalue" ],
58 'optional-args' => [ "where", "metapos", "metamode", "prevmetavalue", "d", "dv", "f" ] },
59
60 "set-index-metadata" => {
61 'compulsory-args' => [ "d", "metaname", "metavalue" ],
62 'optional-args' => [ "metapos", "metamode" ] },
63
64 "set-archives-metadata" => {
65 'compulsory-args' => [ "d", "metaname", "metavalue" ],
66 'optional-args' => [ "dv", "metapos", "metamode", "prevmetavalue" ] }, # metamode can be "accumulate", "override",
67
68 ###### !!!!!
69 # Should there not be a "set-archives-text" also ???!!!!??
70 ###### !!!!!
71
72 "set-archives-assocfile" => {
73 'compulsory-args' => [ "d", "assocname" ],
74 'optional-args' => [ "dv", "fileupload", "filedata" ] ,
75 'help-string' => [ "Because this action uploads a file, this action needs to be POSTed. The 'fileupload' parameter/field is the uploaded file content; 'assocname' specifies the filename within the archives's document's area that it will be saved as" ]
76 },
77
78 "set-import-metadata" => {
79 'compulsory-args' => [ "metaname", "metavalue" ],
80 '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
81
82 #SET METHODS (ARRAY)
83 "set-metadata-array" => {
84 'compulsory-args' => [ "where", "json" ],
85 'optional-args' => [ ],
86 'help-string' => [
87 '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"}]',
88
89 '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"}]' ] },
90
91# The same examples rewritten for when running the metadata-server.pl script from the commandline:
92
93# 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\"}]",
94
95# 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\"}]"
96
97 "set-archives-metadata-array" => {
98 'compulsory-args' => [ "json" ],
99 'optional-args' => [ ] },
100
101 "set-import-metadata-array" => {
102 'compulsory-args' => [ "json" ],
103 'optional-args' => [ ] },
104
105 "set-index-metadata-array" => {
106 'compulsory-args' => [ "json" ],
107 'optional-args' => [ ] },
108
109 "set-live-metadata-array" => {
110 'compulsory-args' => [ "json" ],
111 'optional-args' => [ ] },
112
113 #REMOVE METHODS
114 "remove-import-metadata" => {
115 'compulsory-args' => [ "d", "metaname" ], #TODO: add f argument
116 'optional-args' => [ "metapos", "metavalue", "metamode" ] }, # only provide metapos arg for SIMPLE collections.
117# 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.
118
119 "remove-archives-metadata" => {
120 'compulsory-args' => [ "d", "metaname" ], #TODO: add f argument
121 'optional-args' => [ "dv", "metapos", "metavalue", "metamode" ] },
122
123 "remove-live-metadata" => {
124 'compulsory-args' => [ "d", "metaname" ],
125 'optional-args' => [ ] },
126
127 "remove-index-metadata" => {
128 'compulsory-args' => [ "d", "metaname" ],
129 'optional-args' => [ "metapos", "metavalue" ] },
130
131 "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
132 'compulsory-args' => [ "d", "metaname" ],
133 'optional-args' => [ "where", "dv", "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
134
135 #REMOVE METHODS (ARRAY)
136 "remove-metadata-array" => {
137 'compulsory-args' => [ "where", "json" ],
138 'optional-args' => [ ],
139 'help-string' => [
140 "No remove-metadata-array examples yet."
141 ] },
142 "remove-archives-metadata-array" => {
143 'compulsory-args' => [ "json" ],
144 'optional-args' => [ ] },
145
146 "remove-import-metadata-array" => {
147 'compulsory-args' => [ "json" ],
148 'optional-args' => [ ] },
149
150 "remove-index-metadata-array" => {
151 'compulsory-args' => [ "json" ],
152 'optional-args' => [ ] },
153
154 "remove-live-metadata-array" => {
155 'compulsory-args' => [ "json" ],
156 'optional-args' => [ ] },
157
158 #REMOVE MULTIPLE (REMOVE ALL MATCHING METANAME AT DOCID)
159 "erase-import-metadata" => {
160 'compulsory-args' => [ "d", "metaname" ] },
161
162 "erase-archives-metadata" => {
163 'compulsory-args' => [ "d", "metaname" ],
164 'optional-args' => [ "dv" ] },
165
166 "erase-index-metadata" => {
167 'compulsory-args' => [ "d", "metaname" ] },
168
169 "erase-live-metadata" => {
170 'compulsory-args' => [ "d", "metaname" ] },
171
172 "erase-metadata" => { # generic erase-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
173 'compulsory-args' => [ "d", "metaname" ],
174 'optional-args' => [ "where" ] },
175
176
177 #INSERT METHODS
178 "insert-metadata" => {
179 'compulsory-args' => [ "d", "metaname", "metavalue" ],
180 'optional-args' => [ ] },
181
182
183 #INC METHODS
184 "inc-fldv-nminus1" => {
185 'compulsory-args' => [ "d" ],
186 'optional-args' => [ ] }
187};
188
189sub _set_live_metadata
190{
191 my $self = shift @_;
192
193 my $collect = $self->{'collect'};
194 my $gsdl_cgi = $self->{'gsdl_cgi'};
195 my $infodbtype = $self->{'infodbtype'};
196
197 # Obtain the collect dir
198 my $site = $self->{'site'};
199 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
200
201
202 # look up additional args
203 my $docid = $self->{'d'};
204 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
205 $gsdl_cgi->generate_error("No docid (d=...) specified."); # generates error and dies
206 }
207 my $metavalue = $self->{'metavalue'};
208
209 # Generate the dbkey
210 my $metaname = $self->{'metaname'};
211 my $dbkey = "$docid.$metaname";
212
213 # To people who know $collect_tail please add some comments
214 # Obtain path to the database
215 my $collect_tail = $collect;
216 $collect_tail =~ s/^.*[\/|\\]//;
217 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
218 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
219
220 # Set the new value
221 my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
222 my $status = system($cmd);
223 if ($status != 0) {
224 # Catch error if gdbmget failed
225 my $mess = "Failed to set metadata key: $dbkey\n";
226
227 $mess .= "PATH: $ENV{'PATH'}\n";
228 $mess .= "cmd = $cmd\n";
229 $mess .= "Exit status: $status\n";
230 $mess .= "System Error Message: $!\n";
231
232 $gsdl_cgi->generate_error($mess);
233 }
234 else {
235 $gsdl_cgi->generate_ok_message("set-live-metadata successful: Key[$metaname]=$metavalue");
236 }
237
238 #return $status; # in case calling functions have any further use for this
239}
240
241sub set_live_metadata
242{
243 my $self = shift @_;
244
245 my $username = $self->{'username'};
246 my $collect = $self->{'collect'};
247 my $gsdl_cgi = $self->{'gsdl_cgi'};
248
249 if ($baseaction::authentication_enabled) {
250 # Ensure the user is allowed to edit this collection
251 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
252 }
253
254 # Make sure the collection isn't locked by someone else
255 $self->lock_collection($username, $collect);
256
257 $self->_set_live_metadata(@_);
258
259 # Release the lock once it is done
260 $self->unlock_collection($username, $collect);
261}
262
263sub set_index_metadata_entry
264{
265 my $self = shift @_;
266 my ($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue) = @_;
267
268 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
269 $prevmetavalue = undef if(defined $prevmetavalue && ($prevmetavalue =~ m/^\s*$/));
270
271 # To people who know $collect_tail please add some comments
272 # Obtain path to the database
273 my $collect_tail = $collect;
274 $collect_tail =~ s/^.*[\/|\\]//;
275 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
276 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
277
278# print STDERR "**** infodb file path = $infodb_file_path\n";
279# print STDERR "***** infodb type = $infodbtype\n";
280
281 # Read the docid entry
282 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
283
284 # Set the metadata value
285 if (defined $metapos) {
286 # if metamode=accumulate AND metapos, warn user and then use metapos
287 if (defined $metamode && $metamode eq "accumulate") {
288 print STDERR "**** Warning: metamode is set to accumulate yet metapos is also provided for $docid\n";
289 print STDERR "**** Proceeding by using metapos\n";
290 }
291 $doc_rec->{$metaname}->[$metapos] = $metavalue;
292 }
293 elsif (defined $prevmetavalue) {
294 my $array = $doc_rec->{$metaname};
295 my $length = @$array;
296
297 my $found = 0;
298 for (my $i = 0; $i < $length; $i++){
299 if(defined $doc_rec->{$metaname}->[$i] && $doc_rec->{$metaname}->[$i] eq $prevmetavalue){
300 $doc_rec->{$metaname}->[$i] = $metavalue;
301 $found = 1;
302 last;
303 }
304 }
305
306 if($found == 0){
307 print STDERR "**** Warning: could not find $prevmetavalue to replace. Appending (accumulating) replacement value.\n";
308 ##$doc_rec->{$metaname} = [ $metavalue ]; # if prevmetavalue not found, don't overwrite all previous values.
309 # Accumulate is less destructive. But should the correct behaviour be to not do Anything?
310
311 if(defined $doc_rec->{$metaname}) {
312 push(@{$doc_rec->{$metaname}}, $metavalue); # accumulate the value for that metaname
313 } else {
314 $doc_rec->{$metaname} = [ $metavalue ];
315 }
316 }
317 }
318 elsif (defined $metamode && $metamode eq "override") {
319 $doc_rec->{$metaname} = [ $metavalue ];
320 }
321 else { # default for index was to override, but because accumulate is less destructive,
322 # and because accumulate is the default for archives and import, that's the new default for index too
323 if(defined $doc_rec->{$metaname}) {
324 push(@{$doc_rec->{$metaname}}, $metavalue); # accumulate the value for that metaname
325 } else {
326 $doc_rec->{$metaname} = [ $metavalue ];
327 }
328 }
329
330 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path,$docid,$doc_rec);
331
332 return $status;
333
334}
335
336sub _set_import_metadata
337{
338 my $self = shift @_;
339
340 my $collect = $self->{'collect'};
341 my $gsdl_cgi = $self->{'gsdl_cgi'};
342 my $infodbtype = $self->{'infodbtype'};
343
344 # Obtain the collect and archive dir
345 my $site = $self->{'site'};
346 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
347 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
348
349 # look up additional args
350 # want either d= or f=
351 my $docid = $self->{'d'};
352 my ($docid_root,$docid_secnum);
353 if(defined $docid) {
354 ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
355 # as yet no support for setting subsection metadata in metadata.xml
356 if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
357 $gsdl_cgi->generate_message("*** No support yet for setting import metadata at subsections level.\n");
358 return;
359 }
360 }
361
362 my $import_file = $self->{'f'};
363 if ((!defined $docid || $docid =~ m/^\s*$/) && (!defined $import_file || $import_file =~ m/^\s*$/)) {
364 $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified."); # at least d or f must be specified
365 }
366
367 # Get the parameters and set default mode to "accumulate"
368 my $metaname = $self->{'metaname'};
369 my $metavalue = $self->{'metavalue'};
370## $metavalue =~ s/&amp;lt;(.*?)&amp;gt;/<$1>/g;
371 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
372
373 my $metamode = $self->{'metamode'};
374 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
375 # make "accumulate" the default (less destructive, as it won't actually
376 # delete any existing values)
377 $metamode = "accumulate";
378 }
379
380 # adding metapos and prevmetavalue support to import_metadata subroutines
381 my $metapos = $self->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
382 my $prevmetavalue = $self->{'prevmetavalue'};
383 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
384 $prevmetavalue = undef if(defined $prevmetavalue && ($prevmetavalue =~ m/^\s*$/));
385
386 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
387 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
388
389 my $mess = "set-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
390 $mess .= " $metaname";
391 $mess .= " = $metavalue";
392 $mess .= " ($metamode)\n";
393
394 $gsdl_cgi->generate_ok_message($mess);
395
396 #return $status; # in case calling functions have any further use for this
397}
398
399# the version of set_archives_meta that doesn't do authentication
400sub _set_archives_metadata
401{
402 my $self = shift @_;
403
404 my $collect = $self->{'collect'};
405 my $gsdl_cgi = $self->{'gsdl_cgi'};
406 my $infodbtype = $self->{'infodbtype'};
407
408 # Obtain the collect and archive dir
409 my $site = $self->{'site'};
410 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
411 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
412
413 # look up additional args
414 my $docid = $self->{'d'};
415 my $dv = $self->{'dv'};
416
417 my $metaname = $self->{'metaname'};
418 my $metavalue = $self->{'metavalue'};
419 my $prevmetavalue = $self->{'prevmetavalue'};
420
421 my $metapos = $self->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
422 # Don't append "|| undef", since if metapos=0 it will then be set to undef
423
424 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
425 $prevmetavalue = undef if(defined $prevmetavalue && ($prevmetavalue =~ m/^\s*$/));
426
427 my $metamode = $self->{'metamode'};
428 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
429 # make "accumulate" the default (less destructive, as it won't actually
430 # delete any existing values)
431 $metamode = "accumulate";
432 }
433
434 my $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,
435 $docid,$dv, $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
436
437 if ($status == 0) {
438 my $mess = "set-archives-metadata successful: Key[$docid]\n";
439 $mess .= " $metaname";
440 $mess .= "->[$metapos]" if (defined $metapos);
441 $mess .= " = $metavalue";
442 $mess .= " ($metamode)\n";
443
444 $gsdl_cgi->generate_ok_message($mess);
445 }
446 else {
447 my $mess .= "Failed to set archives metadata key: $docid\n";
448 $mess .= "Exit status: $status\n";
449 if(defined $self->{'error_msg'}) {
450 $mess .= "Error Message: $self->{'error_msg'}\n";
451 } else {
452 $mess .= "System Error Message: $!\n";
453 }
454 $mess .= "-" x 20 . "\n";
455
456 $gsdl_cgi->generate_error($mess);
457 }
458
459 #return $status; # in case calling functions have any further use for this
460}
461
462
463# the version of set_index_meta that doesn't do authentication
464sub _set_index_metadata
465{
466 print STDERR "START SET INDEX METADATA\n";
467 my $self = shift @_;
468
469 my $collect = $self->{'collect'};
470 my $gsdl_cgi = $self->{'gsdl_cgi'};
471
472 # Obtain the collect dir
473 my $site = $self->{'site'};
474 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
475
476 # look up additional args
477 my $docid = $self->{'d'};
478 my $metaname = $self->{'metaname'};
479 my $metapos = $self->{'metapos'}; # undef has meaning
480 my $metavalue = $self->{'metavalue'};
481 my $infodbtype = $self->{'infodbtype'};
482 my $metamode = $self->{'metamode'};
483 my $prevmetavalue = $self->{'prevmetavalue'};
484
485 print STDERR "SETTING INDEX METADATA ENTRY\n";
486 my $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
487 print STDERR "DONE SETTING INDEX METADATA ENTRY\n";
488 if ($status != 0) {
489 # Catch error if set infodb entry failed
490 my $mess = "Failed to set metadata key: $docid\n";
491
492 $mess .= "PATH: $ENV{'PATH'}\n";
493 $mess .= "Exit status: $status\n";
494 $mess .= "System Error Message: $!\n";
495
496 $gsdl_cgi->generate_error($mess);
497 }
498 else {
499 my $mess = "set-index-metadata successful: Key[$docid]\n";
500 $mess .= " $metaname";
501 $mess .= "->[$metapos]" if (defined $metapos);
502 $mess .= " = $metavalue\n";
503
504 $gsdl_cgi->generate_ok_message($mess);
505 }
506
507 print STDERR "END SET INDEX METADATA\n";
508 #return $status; # in case calling functions have any further use for this
509}
510
511sub set_index_metadata
512{
513 my $self = shift @_;
514
515 my $username = $self->{'username'};
516 my $collect = $self->{'collect'};
517 my $gsdl_cgi = $self->{'gsdl_cgi'};
518
519 if ($baseaction::authentication_enabled) {
520 # Ensure the user is allowed to edit this collection
521 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
522 }
523
524 # Obtain the collect dir
525 my $site = $self->{'site'};
526 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
527
528 $gsdl_cgi->checked_chdir($collect_dir);
529
530 # Make sure the collection isn't locked by someone else
531 $self->lock_collection($username, $collect);
532
533 $self->_set_index_metadata(@_);
534
535 # Release the lock once it is done
536 $self->unlock_collection($username, $collect);
537}
538
539# call this to set the metadata for a combination of dirs archives, import or index, or live
540# if none specified, defaults to index which was the original behaviour of set_metadata.
541sub set_metadata
542{
543 my $self = shift @_;
544
545 # Testing that not defining a variable, setting it to "" or to " " all return false
546 # >perl -e 'my $whichdirs=""; if($whichdirs) {print "$whichdirs\n"};'
547
548 my $where = $self->{'where'};
549 if(!$where || ($where =~ m/^\s*$/)) {
550 $self->set_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
551 return;
552 }
553
554 # authenticate and lock collection once, even if processing multiple dirs
555 my $username = $self->{'username'};
556 my $collect = $self->{'collect'};
557 my $gsdl_cgi = $self->{'gsdl_cgi'};
558
559 if ($baseaction::authentication_enabled) {
560 # Ensure the user is allowed to edit this collection
561 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
562 }
563
564 if($where =~ m/index/) {
565 my $site = $self->{'site'};
566 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
567 $gsdl_cgi->checked_chdir($collect_dir);
568 }
569
570 # Make sure the collection isn't locked by someone else
571 $self->lock_collection($username, $collect);
572
573
574 # now at last can set the metadata. $where can specify multiple
575 # $where is of the form: import|archives|index, or a subset thereof
576
577 #my @whichdirs = split('\|', $where);
578
579 # just check whether $where contains import/archives/index/live in turn, and
580 # for each case, process it accordingly
581 if($where =~ m/import/) {
582 $self->_set_import_metadata(@_);
583 }
584
585 if($where =~ m/archives/) {
586
587 # look up docID arg which is optional to set_metadata because it's optional
588 # to set_import, but which is compulsory to set_archives_metadata
589 my $docid = $self->{'d'};
590 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
591 $gsdl_cgi->generate_error("No docid (d=...) specified."); # generates error and dies
592 }
593 # we have a docid, so can set archives meta
594 $self->_set_archives_metadata(@_);
595 }
596
597 if($where =~ m/index/) {
598
599 # look up docID arg which is optional to set_metadata because it's optional
600 # to set_import, but which is compulsory to set_archives_metadata
601 my $docid = $self->{'d'};
602 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
603 $gsdl_cgi->generate_error("No docid (d=...) specified.");
604 }
605 # we have a docid, so can set index meta
606 $self->_set_index_metadata(@_);
607 }
608
609 if($where =~ m/live/) {
610 $self->_set_live_metadata(@_); # docid param, d, is compulsory, but is checked for in subroutine
611 }
612
613 # Release the lock once it is done
614 $self->unlock_collection($username, $collect);
615}
616
617sub set_metadata_array
618{
619 my $self = shift @_;
620
621 my $where = $self->{'where'};
622 if(!$where || ($where =~ m/^\s*$/)) {
623 $self->set_index_metadata_array(@_); # default behaviour is the full version of set_index_meta_array
624 return;
625 }
626
627 my $username = $self->{'username'};
628 my $collect = $self->{'collect'};
629 my $gsdl_cgi = $self->{'gsdl_cgi'};
630
631 if ($baseaction::authentication_enabled) {
632 # Ensure the user is allowed to edit this collection
633 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
634 }
635
636 # Not sure if the checked_chdir into the collect directory is necessary,
637 # since lock_collection does a further chdir into the collection directory anyway
638 # But including the stmt during this code reorganisation to preserve as-is what used to happen
639 my $site = $self->{'site'};
640 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
641 $gsdl_cgi->checked_chdir($collect_dir);
642
643 # Make sure the collection isn't locked by someone else
644 $self->lock_collection($username, $collect);
645
646 if($where =~ m/import/) {
647 $self->_set_import_metadata_array(@_);
648 }
649 if($where =~ m/archives/) {
650 $self->_set_archives_metadata_array(@_);
651 }
652 if($where =~ m/index/) {
653 $self->_set_index_metadata_array(@_);
654 }
655 if($where =~ m/live/) {
656 $self->_set_live_metadata_array(@_);
657 }
658
659 # Release the lock once it is done
660 $self->unlock_collection($username, $collect);
661}
662
663sub _set_index_metadata_array
664{
665 my $self = shift @_;
666
667 my $collect = $self->{'collect'};
668 my $gsdl_cgi = $self->{'gsdl_cgi'};
669
670 # Obtain the collect dir
671 my $site = $self->{'site'};
672 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
673
674 # look up additional args
675
676 my $infodbtype = $self->{'infodbtype'};
677
678 my $json_str = $self->{'json'};
679 my $doc_array = decode_json $json_str;
680
681
682 my $global_status = 0;
683 my $global_mess = "";
684
685 my @all_docids = ();
686
687 foreach my $doc_array_rec ( @$doc_array ) {
688
689 my $status = -1;
690 my $docid = $doc_array_rec->{'docid'};
691
692 push(@all_docids,$docid);
693
694 my $metaname = $doc_array_rec->{'metaname'};
695 if(defined $metaname) {
696 my $metapos = $doc_array_rec->{'metapos'}; # can legitimately be undef
697 my $metavalue = $doc_array_rec->{'metavalue'};
698 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
699
700 $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode);
701 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
702 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
703
704 foreach my $metatable_rec ( @$metatable ) { # the subarray metatable is an array of hashmaps
705 $metaname = $metatable_rec->{'metaname'};
706 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
707 my $metapos = undef;
708 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
709
710 foreach my $metavalue ( @$metavals ) { # metavals is an array
711 $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode); # how do we use metamode in set_meta_entry?
712 if($metamode eq "override") { # now, having overridden the metavalue for the first,
713 # need to accumulate subsequent metavals for this metaname, else the just-assigned
714 # metavalue for this metaname will be lost
715 $metamode = "accumulate";
716 }
717 }
718 }
719 }
720
721 if ($status != 0) {
722 # Catch error if set infodb entry failed
723 $global_status = $status;
724 $global_mess .= "Failed to set metadata key: $docid\n";
725 $global_mess .= "Exit status: $status\n";
726 $global_mess .= "System Error Message: $!\n";
727 $global_mess .= "-" x 20;
728 }
729 }
730
731 if ($global_status != 0) {
732 $global_mess .= "PATH: $ENV{'PATH'}\n";
733 $gsdl_cgi->generate_error($global_mess);
734 }
735 else {
736 my $mess = "set-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
737 $gsdl_cgi->generate_ok_message($mess);
738 }
739}
740
741sub set_index_metadata_array
742{
743 my $self = shift @_;
744
745 my $username = $self->{'username'};
746 my $collect = $self->{'collect'};
747 my $gsdl_cgi = $self->{'gsdl_cgi'};
748
749 if ($baseaction::authentication_enabled) {
750 # Ensure the user is allowed to edit this collection
751 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
752 }
753
754 # Obtain the collect dir
755 my $site = $self->{'site'};
756 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
757
758 $gsdl_cgi->checked_chdir($collect_dir);
759
760
761 # Make sure the collection isn't locked by someone else
762 $self->lock_collection($username, $collect);
763
764 $self->_set_index_metadata_array(@_);
765
766 # Release the lock once it is done
767 $self->unlock_collection($username, $collect);
768}
769
770# experimental, newly added in and untested
771sub _set_live_metadata_array
772{
773 my $self = shift @_;
774
775 my $collect = $self->{'collect'};
776 my $gsdl_cgi = $self->{'gsdl_cgi'};
777
778 # Obtain the collect dir
779 my $site = $self->{'site'};
780 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
781
782 # look up additional args
783 my $infodbtype = $self->{'infodbtype'};
784 # To people who know $collect_tail please add some comments
785 # Obtain path to the database
786 my $collect_tail = $collect;
787 $collect_tail =~ s/^.*[\/|\\]//;
788 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
789 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
790
791
792 my $json_str = $self->{'json'};
793 my $doc_array = decode_json $json_str;
794
795
796 my $global_status = 0;
797 my $global_mess = "";
798
799 my @all_docids = ();
800
801
802 foreach my $doc_array_rec ( @$doc_array ) {
803
804 my $status = -1;
805 my $docid = $doc_array_rec->{'docid'};
806
807 push(@all_docids,$docid);
808
809 my $metaname = $doc_array_rec->{'metaname'};
810 if(defined $metaname) {
811 my $dbkey = "$docid.$metaname";
812 my $metavalue = $doc_array_rec->{'metavalue'};
813
814 # Set the new value
815 my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
816 $status = system($cmd);
817
818 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
819 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
820 foreach my $metatable_rec ( @$metatable ) {
821 $metaname = $metatable_rec->{'metaname'};
822 my $dbkey = "$docid.$metaname";
823
824 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
825 foreach my $metavalue ( @$metavals ) {
826 my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
827 $status = system($cmd);
828 }
829 }
830
831 }
832
833 if ($status != 0) {
834 # Catch error if gdbmget failed
835 $global_status = $status;
836 $global_mess .= "Failed to set metadata key: $docid\n"; # $dbkey
837 $global_mess .= "Exit status: $status\n";
838 $global_mess .= "System Error Message: $!\n";
839 $global_mess .= "-" x 20;
840 }
841 }
842
843 if ($global_status != 0) {
844 $global_mess .= "PATH: $ENV{'PATH'}\n";
845 $gsdl_cgi->generate_error($global_mess);
846 }
847 else {
848 my $mess = "set-live-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
849 $gsdl_cgi->generate_ok_message($mess);
850 }
851}
852
853sub set_live_metadata_array
854{
855 my $self = shift @_;
856
857 my $username = $self->{'username'};
858 my $collect = $self->{'collect'};
859 my $gsdl_cgi = $self->{'gsdl_cgi'};
860
861 if ($baseaction::authentication_enabled) {
862 # Ensure the user is allowed to edit this collection
863 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
864 }
865
866 # Obtain the collect dir
867 my $site = $self->{'site'};
868 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
869
870 $gsdl_cgi->checked_chdir($collect_dir);
871
872 # Make sure the collection isn't locked by someone else
873 $self->lock_collection($username, $collect);
874
875 $self->_set_live_metadata_array(@_);
876
877 # Release the lock once it is done
878 $self->unlock_collection($username, $collect);
879}
880
881
882sub dxml_metadata
883{
884 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
885 my $metaname = $parser->{'parameters'}->{'metaname'};
886 my $metamode = $parser->{'parameters'}->{'metamode'};
887
888###!!! print STDERR "**** Processing closing </Metadata> tag\n";
889
890 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
891
892 # Find the right metadata tag and checks if we are going to
893 # override it
894 #
895 # Note: This over writes the first metadata block it
896 # encountered. If there are multiple Sections in the doc.xml, it
897 # might not behave as you would expect
898
899 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
900## print STDERR "**** checking $opt_doc_secnum <=> $curr_secnum\n" if (defined $opt_doc_secnum);
901## print STDERR "**** metamode = $metamode\n";
902
903 if ((!defined $opt_doc_secnum) || ($opt_doc_secnum eq $curr_secnum))
904 {
905 my $name_attr = $attrHash->{'name'};
906 # print STDOUT "*** testing: $name_attr eq $metaname ? and $metamode eq override ?\n";
907 if (($name_attr eq $metaname) && ($metamode eq "override"))
908 {
909 if (!defined $parser->{'parameters'}->{'poscount'})
910 {
911 $parser->{'parameters'}->{'poscount'} = 0;
912 }
913 else
914 {
915 $parser->{'parameters'}->{'poscount'}++;
916 }
917
918 if (defined $parser->{'parameters'}->{'metapos'}) { # if pos defined, ignore any prevmeta if also defined, and just wait for pos match
919
920 if ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}) {
921 ###print STDERR "#### got pos match!!\n";
922 # Get the value and override the current value
923 my $metavalue = $parser->{'parameters'}->{'metavalue'};
924 $attrHash->{'_content'} = $metavalue;
925
926 # until we have clearly determined the role of metamode in doc.xml files (we know what it means in import/metadata.xml files)
927 # we're not setting metamode to override here.
928
929 # Don't want it to wipe out any other pieces of metadata
930 $parser->{'parameters'}->{'metamode'} = "done";
931 }
932 }
933 elsif (defined $parser->{'parameters'}->{'prevmetavalue'}) { # if no pos defined but prevmeta defined, then wait for prevmeta match
934 if ($parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'}) {
935 ###print STDERR "### prev meta value matches\n";
936 my $metavalue = $parser->{'parameters'}->{'metavalue'};
937 $attrHash->{'_content'} = $metavalue;
938
939 # until we have clearly determined the role of metamode in doc.xml files (we know what it means in import/metadata.xml files)
940 # we're not setting metamode to override here.
941
942 $parser->{'parameters'}->{'metamode'} = "done";
943
944 }
945 }
946 # Note that before commit rev 32076, if neither metapos nor prevmeta defined, then code tried to set pos 0 for that metaname to the new value
947 # However that is not how the code works now (and couldn't get it to work that way yet after rev 32076).
948 # What it does now, and what Dr Bainbridge approved of is that:
949 # If no pos or prevmeta defined, then on override, the metavalue set for the specificed metaname becomes the ONLY instance of that metaname
950 # So any earlier instances of that metaname is removed and replaced by the single new instance.
951 }
952 }
953
954 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
955 return [$tagname => $attrHash];
956}
957
958# This method exists purely for catching invalid section numbers that the client
959# requested to edit. Once the parser has reached the end (the final </Archive> tag),
960# we've seen all the Sections in the doc.xml, and none of their section nums matched
961# if the metamode has not been set to 'done' by then.
962sub dxml_archive
963{
964 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
965 my $metamode = $parser->{'parameters'}->{'metamode'};
966
967 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
968 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
969
970 # print STDERR "@@@ $tagname Processing a closing </Archive> tag [$curr_secnum|$opt_doc_secnum]\n";
971
972 if ($metamode ne "done" && $curr_secnum ne $opt_doc_secnum) {
973 #print STDERR "@@@ $tagname Finished processing FINAL Section.\n";
974
975 my $metaname = $parser->{'parameters'}->{'metaname'};
976 my $metavalue = $parser->{'parameters'}->{'metavalue'};
977
978 print STDERR "@@@ Requested section number $opt_doc_secnum not found.\n";
979 print STDERR "\t(last seen section number in document was $curr_secnum)\n";
980 print STDERR "\tDiscarded metadata value '$metavalue' for meta '$metaname'\n";
981 print STDERR "\tin section $opt_doc_secnum.\n";
982 $parser->{'custom_err_msg'} = "Requested section number $opt_doc_secnum not found.";
983 }
984
985 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
986 return [$tagname => $attrHash];
987}
988
989sub dxml_description
990{
991 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
992 my $metamode = $parser->{'parameters'}->{'metamode'};
993
994 my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
995 my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'} || "";
996
997###!!! print STDERR "**** Processing a closing </Description> tag \n";
998 # print STDERR "@@@ $tagname Processing a closing </Description> tag [$curr_secnum|$opt_doc_secnum]\n";
999
1000 # Accumulate the metadata
1001
1002 # We'll be accumulating metadata at this point if we haven't found and therefore
1003 # haven't processed the metadata yet.
1004 # For subsections, this means that if we're at a matching subsection, but haven't
1005 # found the correct metaname to override in that subsection, we accumulate it as new
1006 # meta in the subsection by adding it to the current description.
1007 # If there's no subsection info for the metadata, it will accumulate at the top level
1008 # section description if we hadn't found a matching metaname to override at this point.
1009
1010 # Both curr_secnum and opt_doc_secnum can be "". In the former case, it means we're now
1011 # at the toplevel section. In the latter case, it means we want to process meta in the
1012 # toplevel section. So the eq check between the values below will work in all cases.
1013
1014 # The only time this won't work is if an opt_doc_secnum beyond the section numbers of
1015 # this document has been provided. In that case, the metadata for that opt_doc_secnum
1016 # won't get attached/accumulated to any part of the doc, not even its top-level section.
1017
1018 if ($curr_secnum eq $opt_doc_secnum
1019 && ($metamode eq "accumulate" || $metamode eq "override")) {
1020 # note, metamode would have been set to done if a metadata operation had already succeeded.
1021 # If we get here, we still have the metadata to append.
1022 if ($metamode eq "override") {
1023 print "Got to end of <Description> block. No metadata value to override. Switching 'metamode' to accumulate\n";
1024 }
1025
1026 # If we get to here and metamode is override, this means there
1027 # was no existing value to overide => treat as an append operation
1028
1029 # Tack a new metadata tag on to the end of the <Metadata>+ block
1030 my $metaname = $parser->{'parameters'}->{'metaname'};
1031 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1032
1033 my $metadata_attr = {
1034 '_content' => $metavalue,
1035 'name' => $metaname,
1036 'mode' => "accumulate"
1037 };
1038
1039 my $append_metadata = [ "Metadata" => $metadata_attr ];
1040 my $description_content = $attrHash->{'_content'};
1041 print "Appending metadata to doc.xml\n";
1042
1043 if (ref($description_content)) {
1044 # got some existing interesting nested content
1045 push(@$description_content, " ", $append_metadata, "\n ");
1046 }
1047 else {
1048 #description_content is most likely a string such as "\n"
1049 $attrHash->{'_content'} = [$description_content, " ", $append_metadata ,"\n" ];
1050 }
1051
1052 $parser->{'parameters'}->{'metamode'} = "done";
1053 }
1054 else {
1055 # metamode most likely "done" signifying that it has already found a position to add the metadata to.
1056## print STDERR "**** NOT ACCUMULATE?!? \n";
1057 }
1058 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1059 return [$tagname => $attrHash];
1060}
1061
1062sub edit_xml_file
1063{
1064 my $self = shift @_;
1065 my ($gsdl_cgi, $filename, $start_rules, $rules, $options) = @_;
1066
1067 # use XML::Rules to add it in (read in and out again)
1068 my $parser = XML::Rules->new(start_rules => $start_rules,
1069 rules => $rules,
1070 style => 'filter',
1071 output_encoding => 'utf8' );
1072
1073 my $xml_in = "";
1074 if (!open(MIN,"<$filename")) {
1075 $gsdl_cgi->generate_error("Unable to read in $filename: $!");
1076 }
1077 else {
1078 # Read all the text in
1079 my $line;
1080 while (defined ($line=<MIN>)) {
1081 $xml_in .= $line if($line !~ m/^\s*$/); # preserve all but empty lines
1082 }
1083 close(MIN);
1084
1085 my $MOUT;
1086 if (!open($MOUT,">$filename")) {
1087 $gsdl_cgi->generate_error("Unable to write out to $filename: $!");
1088 }
1089 else {
1090 # Matched lines will get handled by the call backs
1091## my $xml_out = "";
1092
1093 binmode($MOUT,":utf8");
1094 $parser->filter($xml_in,$MOUT, $options);
1095
1096# binmode(MOUT,":utf8");
1097# print MOUT $xml_out;
1098 close($MOUT);
1099 }
1100 }
1101
1102 # copy across any custom error information that was stored during parsing
1103 $self->{'error_msg'} = $parser->{'custom_err_msg'} if(defined $parser->{'custom_err_msg'});
1104}
1105
1106sub edit_doc_xml
1107{
1108 my $self = shift @_;
1109 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metavalue, $metapos, $metamode, $opt_secnum, $prevmetavalue) = @_;
1110
1111 my $info_mess = <<RAWEND;
1112****************************
1113 edit_doc_xml()
1114****************************
1115RAWEND
1116
1117 $info_mess .= " doc_xml_filename = $doc_xml_filename\n" if defined($doc_xml_filename);
1118 $info_mess .= " metaname = $metaname\n" if defined($metaname);
1119 $info_mess .= " metapos = $metapos\n" if defined($metapos);
1120 $info_mess .= " metavalue = $metavalue\n" if defined($metavalue);
1121 $info_mess .= " metamode = $metamode\n" if defined($metamode);
1122 $info_mess .= " opt_secnum = $opt_secnum\n" if defined($opt_secnum);
1123 $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1124
1125 $info_mess .= "****************************\n";
1126
1127 $gsdl_cgi->generate_message($info_mess);
1128
1129 # To monitor which section/subsection number we are in
1130 my @start_rules =
1131 ( 'Section' => \&dxml_start_section );
1132
1133 # use XML::Rules to add it in (read in and out again)
1134 # Set the call back functions
1135 my @rules =
1136 ( _default => 'raw',
1137 'Metadata' => \&dxml_metadata,
1138 'Description' => \&dxml_description,
1139 'Archive' => \&dxml_archive); # just for catching errors at end
1140
1141 # Sets the parameters
1142 my $options = { 'metaname' => $metaname,
1143 'metapos' => $metapos,
1144 'metavalue' => $metavalue,
1145 'metamode' => $metamode,
1146 'prevmetavalue' => $prevmetavalue };
1147
1148 if (defined $opt_secnum) {
1149 $options->{'secnum'} = $opt_secnum;
1150 }
1151
1152 $self->edit_xml_file($gsdl_cgi,$doc_xml_filename,\@start_rules,\@rules,$options);
1153}
1154
1155sub set_archives_metadata_entry
1156{
1157 my $self = shift @_;
1158 my ($gsdl_cgi, $archive_dir, $collect_dir, $collect, $infodbtype, $docid, $dv, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue) = @_;
1159
1160 my $info_mess = <<RAWEND;
1161****************************
1162 set_archives_metadata_entry()
1163****************************
1164RAWEND
1165
1166 $info_mess .= " archive_dir = $archive_dir\n" if defined($archive_dir);
1167 $info_mess .= " collect_dir = $collect_dir\n" if defined($collect_dir);
1168 $info_mess .= " collect = $collect\n" if defined($collect);
1169 $info_mess .= " infodbtype = $infodbtype\n" if defined($infodbtype);
1170 $info_mess .= " docid = $docid\n" if defined($docid);
1171 $info_mess .= " metaname = $metaname\n" if defined($metaname);
1172 $info_mess .= " metapos = $metapos\n" if defined($metapos);
1173 $info_mess .= " metavalue = $metavalue\n" if defined($metavalue);
1174 $info_mess .= " metamode = $metamode\n" if defined($metamode);
1175 $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1176
1177 $info_mess .= "****************************\n";
1178
1179 $gsdl_cgi->generate_message($info_mess);
1180
1181 # Obtain the doc.xml path for the specified docID
1182 my ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
1183
1184 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1185 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid_root);
1186 my $doc_xml_file = $doc_rec->{'doc-file'}->[0];
1187
1188 # check if request if for file-level doc-version history 'nminus-<n>' version
1189 if (defined $dv && ($dv ne "")) {
1190 # Need to insert '_fldv_history/nminus-<n>' into doc_filename
1191
1192 my ($doc_xml_tailname, $doc_xml_dirname) = File::Basename::fileparse($doc_xml_file);
1193 $doc_xml_file = &util::filename_cat($doc_xml_dirname,$FLDV_HISTORY_DIR,$dv,$doc_xml_tailname);
1194 }
1195
1196 # The $doc_xml_file is relative to the archives, and now let's get the full path
1197 my $archives_dir = &util::filename_cat($collect_dir,$collect,"archives");
1198
1199 my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file);
1200
1201 # If we're overriding everything, then $metamode=override combined with $metapos=undefined and $prevmetavalue=undefined
1202 # in which case, we need to remove all metavalues for the metaname at the given (sub)section
1203 # Thereafter, we will finally be setting the overriding metavalue for this metaname
1204 if (!defined $prevmetavalue && !defined $metapos && $metamode eq "override") {
1205 print "override mode with no pos or prev value set. Removing all existing values for $metaname, and setting mode to accumulate for the new value.\n";
1206 # remove all values of $metaname metadata
1207 $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_xml_file), $metaname, undef, undef, $docid_secnum, $metamode);
1208 $metamode = "accumulate";
1209 }
1210 # Edit the doc.xml file with the specified metadata name, value and position.
1211 # TODO: there is a potential problem here as this edit_doc_xml function
1212 # is assuming the simple doc.xml situation where there is only one Section and no SubSections.
1213 # Running import.pl -groupsize will cause this to have multiple sections in one doc.xml
1214
1215 # dxml_metadata method ignores metapos if metamode anything other than override
1216 $self->edit_doc_xml($gsdl_cgi,$doc_xml_filename,
1217 $metaname,$metavalue,$metapos,$metamode,$docid_secnum,$prevmetavalue);
1218
1219 # return 0; # return 0 for now to indicate no error
1220 return (defined $self->{'error_msg'}) ? 1 : 0;
1221}
1222
1223
1224sub set_archives_metadata
1225{
1226 my $self = shift @_;
1227
1228 my $username = $self->{'username'};
1229 my $collect = $self->{'collect'};
1230 my $gsdl_cgi = $self->{'gsdl_cgi'};
1231
1232 if ($baseaction::authentication_enabled) {
1233 # Ensure the user is allowed to edit this collection
1234 $self->authenticate_user($username, $collect);
1235 }
1236
1237 # Make sure the collection isn't locked by someone else
1238 $self->lock_collection($username, $collect);
1239
1240 $self->_set_archives_metadata(@_);
1241
1242 # Release the lock once it is done
1243 $self->unlock_collection($username, $collect);
1244}
1245
1246sub _set_archives_metadata_array
1247{
1248 my $self = shift @_;
1249
1250 my $collect = $self->{'collect'};
1251 my $gsdl_cgi = $self->{'gsdl_cgi'};
1252
1253 # Obtain the collect dir
1254 my $site = $self->{'site'};
1255 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1256
1257 # look up additional args
1258
1259 my $infodbtype = $self->{'infodbtype'};
1260
1261 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1262
1263 my $json_str = $self->{'json'};
1264 my $doc_array = decode_json $json_str;
1265
1266
1267 my $global_status = 0;
1268 my $global_mess = "";
1269
1270 my @all_docids = ();
1271
1272 foreach my $doc_array_rec ( @$doc_array ) {
1273 my $status = -1;
1274 my $docid = $doc_array_rec->{'docid'};
1275 my $dv = $doc_array_rec->{'dv'};
1276
1277 push(@all_docids,$docid);
1278
1279 my $metaname = $doc_array_rec->{'metaname'};
1280 if(defined $metaname) {
1281
1282 my $metapos = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
1283
1284 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1285 my $metavalue = $doc_array_rec->{'metavalue'};
1286 my $prevmetavalue = $self->{'prevmetavalue'}; # to make this sub behave as _set_archives_metadata
1287
1288
1289 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1290 # make "accumulate" the default (less destructive, as it won't actually
1291 # delete any existing values)
1292 $metamode = "accumulate";
1293 }
1294
1295 $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,
1296 $docid,$dv, $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1297 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1298 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1299
1300 foreach my $metatable_rec ( @$metatable ) {
1301 $metaname = $metatable_rec->{'metaname'};
1302 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
1303 my $metapos = undef;
1304 my $prevmetavalue = undef;
1305 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1306
1307 foreach my $metavalue ( @$metavals ) {
1308 $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect,$infodbtype,
1309 $docid,$dv, $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1310
1311 if($metamode eq "override") { # now, having overridden the metavalue for the first,
1312 # need to accumulate subsequent metavals for this metaname, else the just-assigned
1313 # metavalue for this metaname will be lost
1314 $metamode = "accumulate";
1315 }
1316 }
1317 }
1318 }
1319
1320 if ($status != 0) {
1321 # Catch error if set infodb entry failed
1322 $global_status = $status;
1323 $global_mess .= "Failed to set metadata key: $docid\n";
1324 $global_mess .= "Exit status: $status\n";
1325 $global_mess .= "System Error Message: $!\n";
1326 $global_mess .= "-" x 20 . "\n";
1327 }
1328 }
1329
1330 if ($global_status != 0) {
1331 $global_mess .= "PATH: $ENV{'PATH'}\n";
1332 $gsdl_cgi->generate_error($global_mess);
1333 }
1334 else {
1335 my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1336 $gsdl_cgi->generate_ok_message($mess);
1337 }
1338}
1339
1340sub set_archives_metadata_array
1341{
1342 my $self = shift @_;
1343
1344 my $username = $self->{'username'};
1345 my $collect = $self->{'collect'};
1346 my $gsdl_cgi = $self->{'gsdl_cgi'};
1347
1348 if ($baseaction::authentication_enabled) {
1349 # Ensure the user is allowed to edit this collection
1350 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1351 }
1352
1353 # Obtain the collect dir
1354 my $site = $self->{'site'};
1355 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1356
1357 $gsdl_cgi->checked_chdir($collect_dir);
1358
1359 # Make sure the collection isn't locked by someone else
1360 $self->lock_collection($username, $collect);
1361
1362 $self->_set_archives_metadata_array(@_);
1363
1364 # Release the lock once it is done
1365 $self->unlock_collection($username, $collect);
1366}
1367
1368
1369
1370# the version of set_archives_meta that doesn't do authentication
1371sub _set_archives_assocfile
1372{
1373 my $self = shift @_;
1374
1375 my $collect = $self->{'collect'};
1376 my $gsdl_cgi = $self->{'gsdl_cgi'};
1377 my $infodbtype = $self->{'infodbtype'};
1378
1379 # Obtain the collect and archive dir
1380 my $site = $self->{'site'};
1381 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1382 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1383
1384 # look up additional args
1385 my $docid = $self->{'d'};
1386
1387 my $assocname = $self->{'assocname'};
1388
1389 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1390 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1391
1392 my $doc_file = $doc_rec->{'doc-file'}->[0];
1393
1394 # check if request if for file-level doc-version history 'nminus-<n>' version
1395 my $dv = $self->{'dv'};
1396
1397 my ($unused_tailname, $doc_dirname) = File::Basename::fileparse($doc_file);
1398
1399 my $output_file = $assocname;
1400
1401 if (defined $dv && ($dv ne "")) {
1402 # Need to insert '_fldv_history/nminus-<n>' into output_file
1403
1404 $output_file = &util::filename_cat($doc_dirname,$FLDV_HISTORY_DIR,$dv,$output_file);
1405 }
1406 else {
1407 $output_file = &util::filename_cat($doc_dirname,$output_file);
1408 }
1409
1410 my $output_filename = &util::filename_cat($archive_dir, $output_file);
1411
1412 my $filedata = $self->{'filedata'};
1413 my $FIN = $self->{'fileupload'};
1414
1415 if ((!defined $filedata) && (!defined $FIN)) {
1416 $gsdl_cgi->generate_error("set-archives-assocfile: either 'fileupload' or 'filedata' must be set");
1417 }
1418 else {
1419
1420 my $had_error = 0;
1421 my $had_error_mess = undef;
1422
1423 if (defined $filedata) {
1424 if (open(FOUT,">$output_filename")) {
1425 print FOUT $filedata;
1426 close(FOUT);
1427 }
1428 else {
1429 $had_error = 1;
1430 $had_error_mess = "Failed to save filedata to: $output_filename";
1431 print STDERR "Error - $had_error_mess:\n$!\n";
1432 }
1433 }
1434 else {
1435 my $FIN = $self->{'fileupload'};
1436 if (open(FOUT,">$output_filename")) {
1437 binmode(FOUT, ":raw");
1438
1439 while (1) {
1440 my $buffer = "";
1441 my $bytes_read = read($FIN, $buffer, 1024);
1442
1443 if (defined $bytes_read) {
1444 if ($bytes_read>0) {
1445 print FOUT $buffer;
1446 }
1447 last if $bytes_read < 1024;
1448 }
1449 else {
1450 $had_error = 1;
1451 $had_error_mess = "set-archives-assocfile: Failed to open uploaded file for reading: $!\n";
1452 print STDERR "Error - $had_error_mess";
1453 last;
1454 }
1455 }
1456
1457 close($FIN);
1458 close(FOUT);
1459 }
1460 else {
1461 $had_error = 1;
1462 $had_error_mess = "Failed to save file uploaded file as: $output_filename";
1463 print STDERR "Error - $had_error_mess:\n$!\n";
1464 }
1465 }
1466
1467 if (!$had_error) {
1468 my $mess = "set-archives-assocfile successful save uploaded content into 'archives' as: $output_file\n";
1469 $gsdl_cgi->generate_ok_message($mess);
1470 }
1471 else {
1472 $gsdl_cgi->generate_error($had_error_mess);
1473 }
1474 }
1475}
1476
1477
1478sub set_archives_assocfile
1479{
1480 my $self = shift @_;
1481
1482 my $username = $self->{'username'};
1483 my $collect = $self->{'collect'};
1484 my $gsdl_cgi = $self->{'gsdl_cgi'};
1485
1486 if ($baseaction::authentication_enabled) {
1487 # Ensure the user is allowed to edit this collection
1488 $self->authenticate_user($username, $collect);
1489 }
1490
1491
1492 # Make sure the collection isn't locked by someone else
1493 $self->lock_collection($username, $collect);
1494
1495 $self->_set_archives_assocfile(@_);
1496
1497 # Release the lock once it is done
1498 $self->unlock_collection($username, $collect);
1499}
1500
1501
1502sub _remove_archives_metadata
1503{
1504 my $self = shift @_;
1505
1506 my $collect = $self->{'collect'};
1507 my $gsdl_cgi = $self->{'gsdl_cgi'};
1508 my $infodbtype = $self->{'infodbtype'};
1509
1510
1511 # Obtain the collect and archive dir
1512 my $site = $self->{'site'};
1513 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1514
1515 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1516
1517 # look up additional args
1518 my ($docid, $docid_secnum) = ($self->{'d'} =~ m/^(.*?)(\..*)?$/);
1519
1520 my $metaname = $self->{'metaname'};
1521 my $metapos = $self->{'metapos'};
1522 my $metavalue = $self->{'metavalue'};
1523
1524 my $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $infodbtype,
1525 $docid,$dv, $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1526
1527 if ($status == 0)
1528 {
1529 my $mess = "\nremove-archives-metadata successful: \nKey[$docid]\n";
1530 $mess .= " $metaname";
1531 $mess .= "->[$metapos]" if (defined $metapos);
1532 $mess .= " ($metavalue)" if (defined $metavalue);
1533 $gsdl_cgi->generate_ok_message($mess);
1534 }
1535 else
1536 {
1537 my $mess .= "Failed to remove archives metadata key: $docid\n";
1538 $mess .= "Exit status: $status\n";
1539 $mess .= "System Error Message: $!\n";
1540 $mess .= "-" x 20 . "\n";
1541
1542 $gsdl_cgi->generate_error($mess);
1543 }
1544
1545 #return $status; # in case calling functions have a use for this
1546}
1547
1548sub remove_archives_metadata_entry
1549{
1550 my $self = shift @_;
1551 my ($gsdl_cgi, $archive_dir, $infodbtype, $docid, $dv, $metaname, $metapos, $metavalue, $metamode) = @_;
1552
1553 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
1554 $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/)); # necessary to force fallback to undef here
1555
1556 # if the user hasn't told us what to delete, not having given a metavalue or metapos,
1557 # default to deleting the first metavalue for the given metaname
1558 # Beware that if both metapos AND metavalue are defined, both matches (if any)
1559 # seem to get deleted in one single remove_archives_meta action invocation.
1560 # Similarly, if 2 identical metavalues for a metaname exist and that metavalue is being
1561 # deleted, both get deleted.
1562 if(!defined $metapos && !defined $metavalue) {
1563 $metapos = 0;
1564 }
1565
1566 my $metamode = $self->{'metamode'};
1567 $metamode = undef if(defined $metamode && ($metamode =~ m/^\s*$/));
1568
1569 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1570 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1571
1572 # This now stores the full pathname
1573 my $doc_file = $doc_rec->{'doc-file'}->[0];
1574
1575 # check if request if for file-level doc-version history 'nminus-<n>' version
1576 my $dv = $self->{'dv'};
1577 if (defined $dv && ($dv ne "")) {
1578 # Need to insert '_fldv_history/nminus-<n>' into doc_filename
1579
1580 my ($doc_tailname, $doc_dirname) = File::Basename::fileparse($doc_file);
1581 $doc_file = &util::filename_cat($doc_dirname,$FLDV_HISTORY_DIR,$dv,$doc_tailname);
1582 }
1583
1584 my $doc_filename = &util::filename_cat($archive_dir, $doc_file);
1585
1586 my $status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename, $metaname, $metapos, $metavalue, $docid_secnum, $metamode);
1587# my $status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename, $metaname, $metapos, undef, $docid_secnum);
1588
1589 return $status;
1590}
1591
1592sub remove_archives_metadata
1593{
1594 my $self = shift @_;
1595
1596 my $username = $self->{'username'};
1597 my $collect = $self->{'collect'};
1598 my $gsdl_cgi = $self->{'gsdl_cgi'};
1599
1600 if ($baseaction::authentication_enabled)
1601 {
1602 # Ensure the user is allowed to edit this collection
1603 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1604 }
1605
1606 # Make sure the collection isn't locked by someone else
1607 $self->lock_collection($username, $collect);
1608
1609 $self->_remove_archives_metadata(@_);
1610
1611 # Release the lock once it is done
1612 $self->unlock_collection($username, $collect);
1613}
1614
1615sub remove_from_doc_xml
1616{
1617 my $self = shift @_;
1618 my ($gsdl_cgi, $doc_xml_filename, $metaname, $metapos, $metavalue, $secid, $metamode) = @_;
1619
1620 my @start_rules = ('Section' => \&dxml_start_section);
1621
1622 # Set the call-back functions for the metadata tags
1623 my @rules =
1624 (
1625 _default => 'raw',
1626 'Metadata' => \&rfdxml_metadata
1627 );
1628
1629 my $parser = XML::Rules->new
1630 (
1631 start_rules => \@start_rules,
1632 rules => \@rules,
1633 style => 'filter',
1634 output_encoding => 'utf8',
1635# normalisespaces => 1, # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1636 stripspaces => 2|0|0 # ineffectual
1637 );
1638
1639 my $status = 0;
1640 my $xml_in = "";
1641 if (!open(MIN,"<$doc_xml_filename"))
1642 {
1643 $gsdl_cgi->generate_error("Unable to read in $doc_xml_filename: $!");
1644 $status = 1;
1645 }
1646 else
1647 {
1648 # Read them in
1649 my $line;
1650 while (defined ($line=<MIN>)) {
1651 $xml_in .= $line if($line !~ m/^\s*$/); # preserve all but empty lines
1652 }
1653 close(MIN);
1654
1655 # Filter with the call-back functions
1656 my $xml_out = "";
1657
1658 my $MOUT;
1659 if (!open($MOUT,">$doc_xml_filename")) {
1660 $gsdl_cgi->generate_error("Unable to write out to $doc_xml_filename: $!");
1661 $status = 1;
1662 }
1663 else {
1664 binmode($MOUT,":utf8");
1665 $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, secid => $secid, metamode => $metamode});
1666 close($MOUT);
1667 }
1668 }
1669 return $status;
1670}
1671
1672sub rfdxml_metadata
1673{
1674 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1675
1676 # For comparisons, toplevel section is indicated by ""
1677 my $curr_sec_num = $parser->{'parameters'}->{'curr_section_num'} || "";
1678 my $secid = $parser->{'parameters'}->{'secid'} || "";
1679
1680 if (!($secid eq $curr_sec_num))
1681 {
1682 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1683 return [$tagname => $attrHash];
1684 }
1685
1686 if ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
1687 {
1688 if (!defined $parser->{'parameters'}->{'poscount'})
1689 {
1690 $parser->{'parameters'}->{'poscount'} = 0;
1691 }
1692 else
1693 {
1694 $parser->{'parameters'}->{'poscount'}++;
1695 }
1696
1697 # if overriding (for set-meta) but no metapos, then clear all the meta for this metaname
1698 if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'}) &&(!defined $parser->{'parameters'}->{'metavalue'})) {
1699 return [];
1700 }
1701
1702 if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
1703 {
1704 return [];
1705 }
1706
1707 if ((defined $parser->{'parameters'}->{'metavalue'}) && ($parser->{'parameters'}->{'metavalue'} eq $attrHash->{'_content'}))
1708 {
1709 return [];
1710 }
1711 }
1712
1713 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1714 return [$tagname => $attrHash];
1715}
1716
1717sub mxml_metadata
1718{
1719 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1720 my $metaname = $parser->{'parameters'}->{'metaname'};
1721 my $metamode = $parser->{'parameters'}->{'metamode'};
1722
1723 # Report error if we don't see FileName tag before this
1724 die "Fatal Error: Unexpected metadata.xml structure. Undefined current_file, possibly encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1725
1726 # Don't do anything if we are not in the right FileSet
1727 my $file_regexp = $parser->{'parameters'}->{'current_file'};
1728 if ($file_regexp =~ /\.\*/) {
1729 # Only interested in a file_regexp if it specifies precisely one
1730 # file.
1731 # So, skip anything with a .* in it as it is too general
1732## print STDERR "@@@@ Skipping entry in metadata.xml where FileName=.* as it is too general\n";
1733 return [$tagname => $attrHash];
1734 }
1735 my $src_file = $parser->{'parameters'}->{'src_file'};
1736 if (!($src_file =~ /$file_regexp/)) {
1737 return [$tagname => $attrHash];
1738 }
1739## print STDERR "*** mxl metamode = $metamode\n";
1740
1741 # Find the right metadata tag and checks if we are going to override it
1742 my $name_attr = $attrHash->{'name'};
1743 if (($name_attr eq $metaname) && ($metamode eq "override")) {
1744
1745 # now metadata.xml functions need to keep track of metapos
1746 if (!defined $parser->{'parameters'}->{'poscount'})
1747 {
1748 $parser->{'parameters'}->{'poscount'} = 0;
1749 }
1750 else
1751 {
1752 $parser->{'parameters'}->{'poscount'}++;
1753 }
1754
1755 # If either the metapos or prevmetavalue is set,
1756 # get the value and override the current value
1757 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1758
1759 if(defined $parser->{'parameters'}->{'prevmetavalue'} && $parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'})
1760 {
1761 $attrHash->{'_content'} = $metavalue;
1762
1763 ## print STDERR "**** overriding metadata.xml\n";
1764
1765 # Don't want it to wipe out any other pieces of metadata
1766 $parser->{'parameters'}->{'metamode'} = "done";
1767 }
1768 elsif(defined $parser->{'parameters'}->{'metapos'} && $parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'})
1769 {
1770 $attrHash->{'_content'} = $metavalue;
1771 $parser->{'parameters'}->{'metamode'} = "done";
1772 }
1773 }
1774
1775 # mxml_description will process the metadata if metadata is accumulate,
1776 # or if we haven't found the metadata to override
1777
1778 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1779 return [$tagname => $attrHash];
1780}
1781
1782
1783sub mxml_description
1784{
1785 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1786 my $metamode = $parser->{'parameters'}->{'metamode'};
1787
1788 # Failed... Report error if we don't see FileName tag before this
1789 die "Fatal Error: Unexpected metadata.xml structure. Undefind current_file, possiblely encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1790
1791 # Don't do anything if we are not in the right FileSet
1792 my $file_regexp = $parser->{'parameters'}->{'current_file'};
1793 if ($file_regexp =~ m/\.\*/) {
1794 # Only interested in a file_regexp if it specifies precisely one
1795 # file.
1796 # So, skip anything with a .* in it as it is too general
1797 return [$tagname => $attrHash];
1798 }
1799 my $src_file = $parser->{'parameters'}->{'src_file'};
1800
1801 if (!($src_file =~ m/$file_regexp/)) {
1802 return [$tagname => $attrHash];
1803 }
1804
1805 # Accumulate the metadata block to the end of the description block
1806 # Note: This adds metadata block to all description blocks, so if there are
1807 # multiple FileSets, it will add to all of them
1808 if (($metamode eq "accumulate") || ($metamode eq "override")) {
1809
1810 # if metamode was "override" but get to here then it failed to
1811 # find an item to override, in which case it should append its
1812 # value to the end, just like the "accumulate" mode
1813
1814 if ($metamode eq "override") {
1815 print "No metadata value to override. Switching 'metamode' to accumulate\n";
1816 }
1817
1818 # tack a new metadata tag on to the end of the <Metadata>+ block
1819 my $metaname = $parser->{'parameters'}->{'metaname'};
1820 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1821
1822 my $metadata_attr = { '_content' => $metavalue,
1823 'name' => $metaname,
1824 'mode' => "accumulate" };
1825
1826 my $append_metadata = [ "Metadata" => $metadata_attr ];
1827 my $description_content = $attrHash->{'_content'};
1828
1829## print STDERR "*** appending to metadata.xml\n";
1830
1831 # append the new metadata element to the end of the current
1832 # content contained inside this tag
1833 if (ref($description_content) eq "") {
1834 # => string or numeric literal
1835 # this is caused by a <Description> block has no <Metadata> child elements
1836 # => set up an empty array in '_content'
1837 $attrHash->{'_content'} = [ "\n" ];
1838 $description_content = $attrHash->{'_content'};
1839 }
1840
1841 push(@$description_content, " ", $append_metadata, "\n ");
1842 $parser->{'parameters'}->{'metamode'} = "done";
1843 }
1844
1845 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1846 return [$tagname => $attrHash];
1847}
1848
1849
1850sub mxml_fileset
1851{
1852 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1853
1854 # Initilise the current_file
1855 # Note: According to http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd
1856 # FileName tag must come before Description tag
1857 $parser->{'parameters'}->{'current_file'} = "";
1858
1859 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1860 return [$tagname => $attrHash];
1861}
1862
1863sub mxml_directorymetadata
1864{
1865 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1866
1867 # if we haven't processed the metadata when we reach the end of metadata.xml
1868 # it's because there's no particular FileSet element whose FileName matched
1869 # In which case, add a new FileSet for this FileName
1870 my $metamode = $parser->{'parameters'}->{'metamode'};
1871 if($metamode ne "done") {
1872
1873 if ($metamode eq "override") {
1874 print "No metadata value to override. Switching 'metamode' to accumulate\n";
1875 }
1876
1877 # If we get to here and metamode is override, this means there
1878 # was no existing value to overide => treat as an append operation
1879
1880 # Create a new FileSet element and append to DirectoryMetadata
1881 # <FileSet>
1882 # <FileName>src_file</FileName>
1883 # <Description>
1884 # <Metadata mode="" name="">metavalue</Metadata>
1885 # </Description>
1886 # </FileSet>
1887 my $src_file = $parser->{'parameters'}->{'src_file'};
1888 my $metaname = $parser->{'parameters'}->{'metaname'};
1889 my $metavalue = $parser->{'parameters'}->{'metavalue'};
1890 my $metadata_attr = {
1891 '_content' => $metavalue,
1892 'name' => $metaname,
1893 'mode' => "accumulate"
1894 };
1895 my $append_metadata = [ "Metadata" => $metadata_attr ];
1896 my $description_attr = { '_content' => [ "\n\t\t ", $append_metadata, "\n\t\t"] };
1897 my $description_element = [ "Description" => $description_attr ];
1898
1899 #_content is not an attribute, it's special and holds the children of this element
1900 # including the textnode value embedded in this element if any.
1901 my $filename_attr = {'_content' => $src_file};
1902 my $filename_element = [ "FileName" => $filename_attr ];
1903
1904 my $fileset_attr = {};
1905 $fileset_attr->{'_content'} = [ "\n\t\t", $filename_element,"\n\t\t",$description_element ,"\n\t" ];
1906 my $fileset = [ "FileSet" => $fileset_attr ]; #my $fileset = [ "FileSet" => {} ];
1907
1908
1909 # get children of dirmeta, and push the new FileSet element onto it
1910 print "Appending metadata to metadata.xml\n";
1911 my $dirmeta_content = $attrHash->{'_content'};
1912 if (ref($dirmeta_content)) {
1913 # got some existing interesting nested content
1914 #push(@$dirmeta_content, " ", $fileset ,"\n ");
1915 push(@$dirmeta_content, "\t", $fileset ,"\n");
1916 }
1917 else {
1918 #description_content is most likely a string such as "\n"
1919 #$attrHash->{'_content'} = [$dirmeta_content, " ", $fileset ,"\n" ];
1920 $attrHash->{'_content'} = [$dirmeta_content, "\t", $fileset ,"\n" ];
1921 }
1922
1923 $parser->{'parameters'}->{'metamode'} = "done";
1924 }
1925 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1926 return [$tagname => $attrHash];
1927}
1928
1929
1930sub edit_metadata_xml
1931{
1932 my $self = shift @_;
1933 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $metamode, $src_file, $prevmetavalue) = @_;
1934
1935 # Set the call-back functions for the metadata tags
1936 my @rules =
1937 ( _default => 'raw',
1938 'FileName' => \&mxml_filename,
1939 'Metadata' => \&mxml_metadata,
1940 'Description' => \&mxml_description,
1941 'FileSet' => \&mxml_fileset,
1942 'DirectoryMetadata' => \&mxml_directorymetadata);
1943
1944 # use XML::Rules to add it in (read in and out again)
1945 my $parser = XML::Rules->new(rules => \@rules,
1946 style => 'filter',
1947 output_encoding => 'utf8',
1948 stripspaces => 2|0|0); # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1949
1950 if (!-e $metadata_xml_filename) {
1951
1952 if (open(MOUT,">$metadata_xml_filename")) {
1953
1954 my $src_file_re = &util::filename_to_regex($src_file);
1955 # shouldn't the following also be in the above utility routine??
1956 # $src_file_re =~ s/\./\\./g;
1957
1958 print MOUT "<?xml version=\"1.0\"?>\n";
1959 print MOUT "<DirectoryMetadata>\n";
1960 print MOUT " <FileSet>\n";
1961 print MOUT " <FileName>$src_file_re</FileName>\n";
1962 print MOUT " <Description>\n";
1963 print MOUT " </Description>\n";
1964 print MOUT " </FileSet>\n";
1965 print MOUT "</DirectoryMetadata>\n";
1966
1967 close(MOUT);
1968 }
1969 else {
1970 $gsdl_cgi->generate_error("Unable to create $metadata_xml_filename: $!");
1971 }
1972 }
1973
1974
1975 my $xml_in = "";
1976 if (!open(MIN,"<$metadata_xml_filename")) {
1977 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
1978 }
1979 else {
1980 # Read them in
1981 my $line;
1982 while (defined ($line=<MIN>)) {
1983 $xml_in .= $line if($line !~ m/^\s*$/); # preserve all but empty lines
1984 }
1985 close(MIN);
1986
1987 # Filter with the call-back functions
1988 my $xml_out = "";
1989
1990 my $MOUT;
1991 if (!open($MOUT,">$metadata_xml_filename")) {
1992 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
1993 }
1994 else {
1995 binmode($MOUT,":utf8");
1996
1997 # Some wise person please find out how to keep the DTD and encode lines in after it gets filtered by this XML::Rules
1998 # At the moment, I will just hack it!
1999 #my $header_with_utf8_dtd = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
2000 #$header_with_utf8_dtd .= "<!DOCTYPE DirectoryMetadata SYSTEM \"http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd\">";
2001 #$xml_out =~ s/\<\?xml\sversion\=\"1.0\"\?\>/$header_with_utf8_dtd/;
2002 #print MOUT $xml_out;
2003
2004 $parser->filter($xml_in, $MOUT, { metaname => $metaname,
2005 metapos => $metapos,
2006 metavalue => $metavalue,
2007 metamode => $metamode,
2008 src_file => $src_file,
2009 prevmetavalue => $prevmetavalue,
2010 current_file => undef} );
2011 close($MOUT);
2012 }
2013 }
2014}
2015
2016
2017sub set_import_metadata
2018{
2019 my $self = shift @_;
2020
2021 my $username = $self->{'username'};
2022 my $collect = $self->{'collect'};
2023 my $gsdl_cgi = $self->{'gsdl_cgi'};
2024
2025 if ($baseaction::authentication_enabled) {
2026 # Ensure the user is allowed to edit this collection
2027 $self->authenticate_user($username, $collect);
2028 }
2029
2030 # Make sure the collection isn't locked by someone else
2031 $self->lock_collection($username, $collect);
2032
2033 $self->_set_import_metadata(@_);
2034
2035 # Release the lock once it is done
2036 $self->unlock_collection($username, $collect);
2037
2038}
2039
2040sub set_import_metadata_array
2041{
2042 my $self = shift @_;
2043
2044 my $username = $self->{'username'};
2045 my $collect = $self->{'collect'};
2046 my $gsdl_cgi = $self->{'gsdl_cgi'};
2047
2048 if ($baseaction::authentication_enabled) {
2049 # Ensure the user is allowed to edit this collection
2050 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2051 }
2052
2053 # Obtain the collect dir
2054 my $site = $self->{'site'};
2055 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2056
2057 $gsdl_cgi->checked_chdir($collect_dir);
2058
2059 # Make sure the collection isn't locked by someone else
2060 $self->lock_collection($username, $collect);
2061
2062 $self->_set_import_metadata_array(@_);
2063
2064 # Release the lock once it is done
2065 $self->unlock_collection($username, $collect);
2066
2067}
2068
2069
2070sub _set_import_metadata_array
2071{
2072 my $self = shift @_;
2073
2074 my $collect = $self->{'collect'};
2075 my $gsdl_cgi = $self->{'gsdl_cgi'};
2076
2077 # Obtain the collect dir
2078 my $site = $self->{'site'};
2079 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2080
2081 # look up additional args
2082
2083 my $infodbtype = $self->{'infodbtype'};
2084
2085 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2086 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2087
2088 my $json_str = $self->{'json'};
2089 my $doc_array = decode_json $json_str;
2090
2091 my $global_status = 0;
2092 my $global_mess = "";
2093
2094 my @all_docids = ();
2095
2096 foreach my $doc_array_rec ( @$doc_array )
2097 {
2098 my $status = -1;
2099 my $docid = $doc_array_rec->{'docid'};
2100
2101 my ($docid_root,$docid_secnum);
2102 if(defined $docid) {
2103 ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
2104 # as yet no support for setting subsection metadata in metadata.xml
2105 if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
2106 $gsdl_cgi->generate_message("*** docid: $docid. No support yet for setting import metadata at subsections level.\n");
2107 next; # skip this docid in for loop
2108 }
2109 }
2110
2111 push(@all_docids,$docid); # docid_root rather
2112
2113 my $metaname = $doc_array_rec->{'metaname'};
2114 if (defined $metaname) {
2115 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
2116 my $metavalue = $doc_array_rec->{'metavalue'};
2117 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2118
2119 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
2120 # make "accumulate" the default (less destructive, as it won't actually
2121 # delete any existing values)
2122 $metamode = "accumulate";
2123 }
2124
2125 # adding metapos and prevmetavalue support to import_metadata subroutines
2126 my $metapos = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
2127 my $prevmetavalue = $self->{'prevmetavalue'};
2128
2129 $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
2130
2131 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
2132 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
2133
2134 foreach my $metatable_rec ( @$metatable ) {
2135 $metaname = $metatable_rec->{'metaname'};
2136 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
2137 if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
2138 # make "accumulate" the default (less destructive, as it won't actually
2139 # delete any existing values)
2140 $metamode = "accumulate";
2141 }
2142
2143 # No support for metapos and prevmetavalue in the JSON metatable substructure
2144 my $metapos = undef;
2145 my $prevmetavalue = undef;
2146 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
2147
2148 foreach my $metavalue ( @$metavals ) {
2149 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2150
2151 $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
2152 if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
2153 # need to accumulate subsequent metavals for this metaname, else the just-assigned
2154 # metavalue for this metaname will be lost
2155 $metamode = "accumulate";
2156 }
2157 }
2158 }
2159 }
2160 }
2161
2162 # always a success message
2163 my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
2164 $gsdl_cgi->generate_ok_message($mess);
2165}
2166
2167# always returns true (1)
2168sub set_import_metadata_entry
2169{
2170 my $self = shift @_;
2171 my ($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue, $collect, $collect_dir) = @_;
2172
2173 my $info_mess = <<RAWEND;
2174****************************
2175 set_import_metadata_entry()
2176****************************
2177RAWEND
2178
2179 $info_mess .= " collect_dir = $collect_dir\n" if defined($collect_dir);
2180 $info_mess .= " collect = $collect\n" if defined($collect);
2181 $info_mess .= " infodbtype = $infodbtype\n" if defined($infodbtype);
2182 $info_mess .= " arcinfo_doc_filename = $arcinfo_doc_filename\n" if defined($arcinfo_doc_filename);
2183 $info_mess .= " docid = $docid\n" if defined($docid);
2184 $info_mess .= " metaname = $metaname\n" if defined($metaname);
2185 $info_mess .= " metapos = $metapos\n" if defined($metapos);
2186 $info_mess .= " metavalue = $metavalue\n" if defined($metavalue);
2187 $info_mess .= " metamode = $metamode\n" if defined($metamode);
2188 $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
2189
2190 $info_mess .= "****************************\n";
2191
2192 $gsdl_cgi->generate_message($info_mess);
2193
2194 # import works with metadata.xml which can have inherited metadata
2195 # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
2196 # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
2197 # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
2198 # what they're doing if they provide a metapos.
2199 if(defined $metapos) {
2200 print STDERR "@@@@ WARNING: metapos defined.\n";
2201 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
2202 }
2203
2204 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2205 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2206 my $metadata_xml_file;
2207 my $import_filename = undef;
2208
2209 if (defined $docid) {
2210 # my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2211 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2212
2213 # This now stores the full pathname
2214 $import_filename = $doc_rec->{'src-file'}->[0];
2215 $import_filename = &util::placeholders_to_abspath($import_filename);
2216
2217 } else { # only for set_import_meta, not the case when calling method is set_import_metadata_array
2218 # as the array version of the method doesn't support the -f parameter yet
2219 my $import_file = $self->{'f'};
2220 $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
2221 }
2222
2223 # figure out correct metadata.xml file [?]
2224 # Assuming the metadata.xml file is next to the source file
2225 # Note: This will not work if it is using the inherited metadata from the parent folder
2226 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2227 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2228
2229 # If we're overriding everything, then $prevmetavalue=undefined and
2230 # $metamode=override combined with $metapos=undefined
2231 # in which case we need to remove all metavalues for the metaname at the given (sub)section
2232 # Thereafter, we will finally be able to set the overriding metavalue for this metaname
2233 if(!defined $prevmetavalue && !defined $metapos && $metamode eq "override") {
2234## print STDERR "@@@ REMOVING all import metadata for $metaname\n";
2235 $self->remove_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, undef, $import_tailname, $metamode); # we're removing all values, so metavalue=undef
2236
2237 }
2238
2239 # Edit the metadata.xml
2240 # Modified by Jeffrey from DL Consulting
2241 # Handle the case where there is one metadata.xml file for multiple FileSets
2242 # The XML filter needs to know whether it is in the right FileSet
2243 # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2244 # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2245 $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2246 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2247 #return 0;
2248 return $metadata_xml_filename;
2249}
2250
2251sub _remove_import_metadata
2252{
2253 my $self = shift @_;
2254
2255 my $collect = $self->{'collect'};
2256 my $gsdl_cgi = $self->{'gsdl_cgi'};
2257 my $infodbtype = $self->{'infodbtype'};
2258
2259 # Obtain the collect and archive dir
2260 my $site = $self->{'site'};
2261 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2262
2263 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2264
2265 # look up additional args
2266 my $docid = $self->{'d'};
2267
2268 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2269
2270 my $metaname = $self->{'metaname'};
2271 my $metapos = $self->{'metapos'};
2272 my $metavalue = $self->{'metavalue'};
2273
2274 my $metamode = $self->{'metamode'};
2275
2276 $self->remove_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode);
2277
2278 # any errors would have been reported inside the remove_import_metadata_entry
2279
2280 my $mess = "remove-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
2281 $mess .= " $metaname";
2282 $mess .= " = $metavalue\n";
2283
2284 $gsdl_cgi->generate_ok_message($mess);
2285
2286 #return $status; # in case calling functions have a use for this
2287}
2288
2289sub remove_import_metadata_entry
2290{
2291 my $self = shift @_;
2292 my ($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode) = @_;
2293
2294 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
2295 $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/));
2296
2297 if(defined $metavalue) { # metavalue is not a compulsory arg for remove_import_metadata()
2298 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2299 } elsif (!defined $metapos) { # if given no metavalue or metapos to delete, default to deleting the 1st
2300 $metapos = 0;
2301 }
2302
2303 $metamode = undef if(defined $metamode && ($metamode =~ m/^\s*$/));
2304
2305 # import works with metadata.xml which can have inherited metadata
2306 # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
2307 # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
2308 # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
2309 # what they're doing if they provide a metapos.
2310 if(defined $metapos) {
2311 print STDERR "@@@@ WARNING: metapos defined.\n";
2312 print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
2313 }
2314
2315 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2316 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2317 my $metadata_xml_file;
2318 my $import_filename = undef;
2319 if ((!defined $docid) || ($docid =~ m/^\s*$/))
2320 {
2321 $gsdl_cgi->generate_error("No docid (d=...) specified.\n");
2322 } else {
2323 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2324
2325 # This now stores the full pathname
2326 $import_filename = $doc_rec->{'src-file'}->[0];
2327 $import_filename = &util::placeholders_to_abspath($import_filename);
2328 }
2329
2330 if((!defined $import_filename) || ($import_filename =~ m/^\s*$/))
2331 {
2332 $gsdl_cgi->generate_error("There is no metadata\n");
2333 }
2334
2335 # figure out correct metadata.xml file [?]
2336 # Assuming the metadata.xml file is next to the source file
2337 # Note: This will not work if it is using the inherited metadata from the parent folder
2338 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2339 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2340
2341 $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
2342
2343 return $error_message;
2344}
2345
2346sub remove_import_metadata
2347{
2348 my $self = shift @_;
2349
2350 my $username = $self->{'username'};
2351 my $collect = $self->{'collect'};
2352 my $gsdl_cgi = $self->{'gsdl_cgi'};
2353
2354 if ($baseaction::authentication_enabled) {
2355 # Ensure the user is allowed to edit this collection
2356 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2357 }
2358
2359 # Make sure the collection isn't locked by someone else
2360 $self->lock_collection($username, $collect);
2361
2362 $self->_remove_import_metadata(@_);
2363
2364 # Release the lock once it is done
2365 $self->unlock_collection($username, $collect);
2366
2367}
2368
2369sub remove_from_metadata_xml
2370{
2371 my $self = shift @_;
2372 my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $src_file, $metamode) = @_;
2373 # metamode generally has no meaning for removing meta, but is used by set_meta
2374 # when overriding all metavals for a metaname, in which case remove_meta is called with metamode
2375
2376 # Set the call-back functions for the metadata tags
2377 my @rules =
2378 (
2379 _default => 'raw',
2380 'Metadata' => \&rfmxml_metadata,
2381 'FileName' => \&mxml_filename
2382 );
2383
2384 my $parser = XML::Rules->new
2385 (
2386 rules => \@rules,
2387 style => 'filter',
2388 output_encoding => 'utf8',
2389 #normalisespaces => 1,
2390 stripspaces => 2|0|0 # ineffectual
2391 );
2392
2393 my $xml_in = "";
2394 if (!open(MIN,"<$metadata_xml_filename"))
2395 {
2396 $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
2397 }
2398 else
2399 {
2400 # Read them in
2401 my $line;
2402 while (defined ($line=<MIN>)) {
2403 $xml_in .= $line if($line !~ m/^\s*$/); # preserve all but empty lines
2404 }
2405 close(MIN);
2406
2407 # Filter with the call-back functions
2408 my $xml_out = "";
2409
2410 my $MOUT;
2411 if (!open($MOUT,">$metadata_xml_filename")) {
2412 $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
2413 }
2414 else {
2415 binmode($MOUT,":utf8");
2416 $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, src_file => $src_file, metamode => $metamode, current_file => undef});
2417 close($MOUT);
2418 }
2419 }
2420}
2421
2422sub rfmxml_metadata
2423{
2424 my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2425
2426 # metadata.xml does not handle subsections
2427
2428 # since metadata.xml now has to deal with metapos, we keep track of the metadata position
2429 if (($parser->{'parameters'}->{'src_file'} eq $parser->{'parameters'}->{'current_file'})
2430 && $parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
2431 {
2432 if (!defined $parser->{'parameters'}->{'poscount'})
2433 {
2434 $parser->{'parameters'}->{'poscount'} = 0;
2435 }
2436 else
2437 {
2438 $parser->{'parameters'}->{'poscount'}++;
2439 }
2440
2441 # if overriding but no metapos, then clear all the meta for this metaname
2442 # This is used by set_import_metadata_entry, so don't change this behaviour
2443 if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'}) && (!defined $parser->{'parameters'}->{'metavalue'})) {
2444 return [];
2445 }
2446
2447 if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
2448 {
2449 return [];
2450 }
2451 if ((defined $parser->{'parameters'}->{'metavalue'}) && ($attrHash->{'_content'} eq $parser->{'parameters'}->{'metavalue'}))
2452 {
2453 return [];
2454 }
2455 }
2456
2457 # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2458 return [$tagname => $attrHash];
2459}
2460
2461sub _remove_live_metadata
2462{
2463 my $self = shift @_;
2464
2465 my $collect = $self->{'collect'};
2466 my $gsdl_cgi = $self->{'gsdl_cgi'};
2467 my $infodbtype = $self->{'infodbtype'};
2468
2469 # Obtain the collect dir
2470 my $site = $self->{'site'};
2471 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2472
2473 # look up additional args
2474 my $docid = $self->{'d'};
2475 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2476 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2477 }
2478
2479 # Generate the dbkey
2480 my $metaname = $self->{'metaname'};
2481 my $dbkey = "$docid.$metaname";
2482
2483 # To people who know $collect_tail please add some comments
2484 # Obtain the live gdbm_db path
2485 my $collect_tail = $collect;
2486 $collect_tail =~ s/^.*[\/|\\]//;
2487 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2488 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
2489
2490 # Remove the key
2491 my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\"";
2492 my $status = system($cmd);
2493 if ($status != 0) {
2494 # Catch error if gdbmdel failed
2495 my $mess = "Failed to delete metadata key: $dbkey\n";
2496
2497 $mess .= "PATH: $ENV{'PATH'}\n";
2498 $mess .= "cmd = $cmd\n";
2499 $mess .= "Exit status: $status\n";
2500 $mess .= "System Error Message: $!\n";
2501
2502 $gsdl_cgi->generate_error($mess);
2503 }
2504 else {
2505 $gsdl_cgi->generate_ok_message("DB remove successful: Key[$metaname]");
2506 }
2507
2508}
2509
2510sub remove_live_metadata
2511{
2512 my $self = shift @_;
2513
2514 my $username = $self->{'username'};
2515 my $collect = $self->{'collect'};
2516 my $gsdl_cgi = $self->{'gsdl_cgi'};
2517
2518 if ($baseaction::authentication_enabled) {
2519 # Ensure the user is allowed to edit this collection
2520 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2521 }
2522
2523 # Make sure the collection isn't locked by someone else
2524 $self->lock_collection($username, $collect);
2525
2526 $self->_remove_live_metadata(@_);
2527
2528 $self->unlock_collection($username, $collect);
2529}
2530
2531sub remove_metadata
2532{
2533 my $self = shift @_;
2534
2535 my $where = $self->{'where'};
2536 if(!$where || ($where =~ m/^\s*$/)) {
2537 $self->remove_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
2538 return;
2539 }
2540
2541 my $username = $self->{'username'};
2542 my $collect = $self->{'collect'};
2543 my $gsdl_cgi = $self->{'gsdl_cgi'};
2544
2545 if ($baseaction::authentication_enabled) {
2546 # Ensure the user is allowed to edit this collection
2547 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2548 }
2549
2550 # Make sure the collection isn't locked by someone else
2551 $self->lock_collection($username, $collect);
2552
2553 # check which directories need to be processed, specified in $where as
2554 # any combination of import|archives|index|live
2555 if($where =~ m/import/) {
2556 $self->_remove_import_metadata(@_);
2557 }
2558 if($where =~ m/archives/) {
2559 $self->_remove_archives_metadata(@_);
2560 }
2561 if($where =~ m/index/) {
2562 $self->_remove_index_metadata(@_);
2563 }
2564
2565 # Release the lock once it is done
2566 $self->unlock_collection($username, $collect);
2567}
2568
2569# the internal version, without authentication
2570sub _remove_index_metadata
2571{
2572 my $self = shift @_;
2573
2574 my $collect = $self->{'collect'};
2575 my $gsdl_cgi = $self->{'gsdl_cgi'};
2576 my $infodbtype = $self->{'infodbtype'};
2577
2578 # Obtain the collect dir
2579 my $site = $self->{'site'};
2580 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2581
2582 # look up additional args
2583 my $docid = $self->{'d'};
2584 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2585 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2586 }
2587 my $metaname = $self->{'metaname'};
2588 my $metapos = $self->{'metapos'};
2589 my $metavalue = $self->{'metavalue'};
2590
2591 my $status = $self->remove_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue);
2592
2593 if ($status != 0) {
2594 my $mess = "Failed to remove metadata key: $docid\n";
2595
2596 $mess .= "PATH: $ENV{'PATH'}\n";
2597 $mess .= "Exit status: $status\n";
2598 $mess .= "System Error Message: $!\n";
2599
2600 $gsdl_cgi->generate_error($mess);
2601 }
2602 else {
2603 my $mess = "DB remove successful: Key[$docid]\n";
2604 $mess .= " $metaname";
2605 $mess .= "->[$metapos]" if (defined $metapos);
2606 $mess .= " ($metavalue)" if (defined $metavalue);
2607
2608 $gsdl_cgi->generate_ok_message($mess);
2609 }
2610
2611 #return $status; # in case calling functions have a use for this
2612}
2613
2614sub remove_index_metadata_entry
2615{
2616 my $self = shift @_;
2617 my ($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue) = @_;
2618
2619 $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
2620 $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/)); # necessary to force fallback to undef here
2621
2622 # To people who know $collect_tail please add some comments
2623 # -> In collection groups, I think collect_tailname is the subcollection name,
2624 # e.g. colgroup-name/col-tail-name
2625 # Obtain the path to the database
2626 my $collect_tail = $collect;
2627 $collect_tail =~ s/^.*[\/|\\]//;
2628 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2629 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2630
2631 # Read the docid entry
2632 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2633
2634 # Check to make sure the key does exist
2635 if (!defined ($doc_rec->{$metaname})) {
2636 $gsdl_cgi->generate_error("No metadata field \"" . $metaname . "\" in the specified document: [" . $docid . "]");
2637 }
2638
2639 # Obtain the specified metadata pos
2640 # if no metavalue or metapos to delete, default to deleting the 1st value for the metaname
2641 if(!defined $metapos && !defined $metavalue) {
2642 $metapos = 0;
2643 }
2644
2645
2646 # consider check key is defined before deleting?
2647 # Loop through the metadata array and ignore the specified position
2648 my $filtered_metadata = [];
2649 my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}});
2650 for (my $i=0; $i<$num_metadata_vals; $i++) {
2651 my $metaval = shift(@{$doc_rec->{$metaname}});
2652
2653 if (!defined $metavalue && $i != $metapos) {
2654 push(@$filtered_metadata,$metaval);
2655 }
2656
2657 if(defined $metavalue && !($metavalue eq $metaval))
2658 {
2659 push(@$filtered_metadata,$metaval);
2660 }
2661 }
2662 $doc_rec->{$metaname} = $filtered_metadata;
2663
2664 ## Use the dbutil set_entry method instead of assuming the database is gdbm
2665 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2666
2667 return $status;
2668}
2669
2670sub remove_index_metadata
2671{
2672 my $self = shift @_;
2673
2674 my $username = $self->{'username'};
2675 my $collect = $self->{'collect'};
2676 my $gsdl_cgi = $self->{'gsdl_cgi'};
2677
2678 if ($baseaction::authentication_enabled) {
2679 # Ensure the user is allowed to edit this collection
2680 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2681 }
2682
2683 # Obtain the collect dir
2684 my $site = $self->{'site'};
2685 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2686
2687 # Make sure the collection isn't locked by someone else
2688 $self->lock_collection($username, $collect);
2689
2690 $self->_remove_index_metadata(@_);
2691
2692 # Release the lock once it is done
2693 $self->unlock_collection($username, $collect);
2694}
2695
2696#################################################################################
2697# ERASE META METHODS: ERASE ALL VALUES FOR MATCHING METANAME AT SPECIFIED DOCID #
2698#################################################################################
2699
2700sub erase_metadata
2701{
2702 my $self = shift @_;
2703
2704 my $where = $self->{'where'};
2705 # when $where is unspecified, following behaviour of sub remove_metadata by defaulting to erasing metadata from index
2706 if(!$where || ($where =~ m/^\s*$/)) {
2707 $self->erase_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
2708 return;
2709 }
2710
2711 my $username = $self->{'username'};
2712 my $collect = $self->{'collect'};
2713 my $gsdl_cgi = $self->{'gsdl_cgi'};
2714
2715 if ($baseaction::authentication_enabled) {
2716 # Ensure the user is allowed to edit this collection
2717 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2718 }
2719
2720 # Make sure the collection isn't locked by someone else
2721 $self->lock_collection($username, $collect);
2722
2723 # check which directories need to be processed, specified in $where as
2724 # any combination of import|archives|index|live
2725 if($where =~ m/import/) {
2726 $self->_erase_import_metadata(@_);
2727 }
2728 if($where =~ m/archives/) {
2729 $self->_erase_archives_metadata(@_);
2730 }
2731 if($where =~ m/index/) {
2732 $self->_erase_index_metadata(@_);
2733 }
2734
2735 # Release the lock once it is done
2736 $self->unlock_collection($username, $collect);
2737}
2738
2739# the internal version, without authentication
2740sub _erase_index_metadata
2741{
2742 my $self = shift @_;
2743
2744 my $collect = $self->{'collect'};
2745 my $gsdl_cgi = $self->{'gsdl_cgi'};
2746 my $infodbtype = $self->{'infodbtype'};
2747
2748 # Obtain the collect dir
2749 my $site = $self->{'site'};
2750 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2751
2752 # look up additional args
2753 my $docid = $self->{'d'};
2754 if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2755 $gsdl_cgi->generate_error("No docid (d=...) specified.");
2756 }
2757 my $metaname = $self->{'metaname'};
2758 my $metapos = undef;
2759 my $metavalue = undef;
2760
2761 # To people who know $collect_tail please add some comments
2762 # -> In collection groups, I think collect_tailname is the subcollection name,
2763 # e.g. colgroup-name/col-tail-name
2764 # Obtain the path to the database
2765 my $collect_tail = $collect;
2766 $collect_tail =~ s/^.*[\/|\\]//;
2767 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2768 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2769
2770 # Read the docid entry
2771 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2772
2773 # Check to make sure the key does exist
2774 if (defined ($doc_rec->{$metaname})) {
2775
2776 $doc_rec->{$metaname} = [];
2777
2778 ## Use the dbutil set_entry method instead of assuming the database is gdbm
2779 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2780
2781 if ($status != 0) {
2782 my $mess = "Failed to erase metadata key: $docid\n";
2783
2784 $mess .= "PATH: $ENV{'PATH'}\n";
2785 $mess .= "Exit status: $status\n";
2786 $mess .= "System Error Message: $!\n";
2787
2788 $gsdl_cgi->generate_error($mess);
2789 }
2790 else {
2791 my $mess = "DB set (with item deleted) successful: Key[$docid]\n";
2792 $mess .= " $metaname";
2793 $mess .= "->[$metapos]" if (defined $metapos);
2794 $mess .= " ($metavalue)" if (defined $metavalue);
2795
2796 $gsdl_cgi->generate_ok_message($mess);
2797 }
2798 }
2799 else { # no such metaname. Is it really an error?
2800 $gsdl_cgi->generate_ok_message("Can't erase. No metadata field \"" . $metaname . "\" in the specified document: [" . $docid . "]");
2801 }
2802 #return $status; # in case calling functions have a use for this
2803}
2804
2805sub erase_index_metadata
2806{
2807 my $self = shift @_;
2808
2809 my $username = $self->{'username'};
2810 my $collect = $self->{'collect'};
2811 my $gsdl_cgi = $self->{'gsdl_cgi'};
2812
2813 if ($baseaction::authentication_enabled) {
2814 # Ensure the user is allowed to edit this collection
2815 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2816 }
2817
2818 # Obtain the collect dir
2819 my $site = $self->{'site'};
2820 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2821
2822 # Make sure the collection isn't locked by someone else
2823 $self->lock_collection($username, $collect);
2824
2825 $self->_erase_index_metadata(@_);
2826
2827 # Release the lock once it is done
2828 $self->unlock_collection($username, $collect);
2829}
2830
2831
2832# Given a metaname, removes ALL metadata with that metaname at the provided docid
2833sub _erase_archives_metadata
2834{
2835 my $self = shift @_;
2836
2837 my $collect = $self->{'collect'};
2838 my $gsdl_cgi = $self->{'gsdl_cgi'};
2839 my $infodbtype = $self->{'infodbtype'};
2840
2841 # Obtain the collect and archive dir
2842 my $site = $self->{'site'};
2843 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2844
2845 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2846
2847 # look up additional args
2848 my ($docid, $docid_secnum) = ($self->{'d'} =~ m/^(.*?)(\..*)?$/);
2849
2850 my $metaname = $self->{'metaname'};
2851
2852 # metapos, metavalue and metamode are never provided and therefore all undefined for erase_archives_metadata
2853 my $metapos = undef;
2854 my $metavalue = undef;
2855 my $metamode = "override"; # when override and no metapos or metaval, all values for metaname will be affected
2856
2857 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2858 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2859
2860 # This now stores the full pathname
2861 my $doc_file = $doc_rec->{'doc-file'}->[0];
2862
2863 # check if request if for file-level doc-version history 'nminus-<n>' version
2864 my $dv = $self->{'dv'};
2865 if (defined $dv && ($dv ne "")) {
2866 # Need to insert '_fldv_history/nminus-<n>' into doc_filename
2867
2868 my ($doc_tailname, $doc_dirname) = File::Basename::fileparse($doc_file);
2869 $doc_file = &util::filename_cat($doc_dirname,$FLDV_HISTORY_DIR,$dv,$doc_tailname);
2870 }
2871
2872 my $doc_filename = &util::filename_cat($archive_dir, $doc_file);
2873
2874 my $status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename, $metaname, $metapos, $metavalue, $docid_secnum, $metamode);
2875
2876 if ($status == 0)
2877 {
2878 my $mess = "\nerase-archives-metadata successful: \nKey[$docid]\n";
2879 $mess .= " $metaname";
2880 $gsdl_cgi->generate_ok_message($mess);
2881 }
2882 else
2883 {
2884 my $mess .= "Failed to erase archives metadata key: $docid\n";
2885 $mess .= "Exit status: $status\n";
2886 $mess .= "System Error Message: $!\n";
2887 $mess .= "-" x 20 . "\n";
2888
2889 $gsdl_cgi->generate_error($mess);
2890 }
2891
2892 #return $status; # in case calling functions have a use for this
2893}
2894
2895# practically identical to remove_archives_metadata
2896sub erase_archives_metadata
2897{
2898 my $self = shift @_;
2899
2900 my $username = $self->{'username'};
2901 my $collect = $self->{'collect'};
2902 my $gsdl_cgi = $self->{'gsdl_cgi'};
2903
2904 if ($baseaction::authentication_enabled)
2905 {
2906 # Ensure the user is allowed to edit this collection
2907 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2908 }
2909
2910 # Make sure the collection isn't locked by someone else
2911 $self->lock_collection($username, $collect);
2912
2913 $self->_erase_archives_metadata(@_);
2914
2915 # Release the lock once it is done
2916 $self->unlock_collection($username, $collect);
2917}
2918
2919sub _erase_import_metadata
2920{
2921 my $self = shift @_;
2922
2923 my $collect = $self->{'collect'};
2924 my $gsdl_cgi = $self->{'gsdl_cgi'};
2925 my $infodbtype = $self->{'infodbtype'};
2926
2927 # Obtain the collect dir
2928 my $site = $self->{'site'};
2929 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2930
2931 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2932
2933 # look up additional args
2934 my $docid = $self->{'d'};
2935 if ((!defined $docid) || ($docid =~ m/^\s*$/))
2936 {
2937 $gsdl_cgi->generate_error("No docid (d=...) specified.\n");
2938 }
2939
2940 my $metaname = $self->{'metaname'};
2941 my $metapos = undef;
2942 my $metavalue = undef;
2943 my $metamode = "override";
2944
2945 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2946 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2947 my $metadata_xml_file;
2948 my $import_filename = undef;
2949 if (defined $docid)
2950 {
2951 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2952 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2953
2954 # This now stores the full pathname
2955 $import_filename = $doc_rec->{'src-file'}->[0];
2956 $import_filename = &util::placeholders_to_abspath($import_filename);
2957 }
2958
2959 if((!defined $import_filename) || ($import_filename =~ m/^\s*$/))
2960 {
2961 $gsdl_cgi->generate_error("There is no metadata\n");
2962 }
2963
2964 # figure out correct metadata.xml file [?]
2965 # Assuming the metadata.xml file is next to the source file
2966 # Note: This will not work if it is using the inherited metadata from the parent folder
2967 my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2968 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2969
2970 $self->remove_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $import_tailname, $metamode); # metamode=override, means all values of metaname are affected
2971
2972 my $mess = "erase-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
2973 $mess .= " $metaname";
2974 $mess .= " = $metavalue\n";
2975
2976 $gsdl_cgi->generate_ok_message($mess);
2977
2978 #return $status; # in case calling functions have a use for this
2979}
2980
2981sub erase_import_metadata
2982{
2983 my $self = shift @_;
2984
2985 my $username = $self->{'username'};
2986 my $collect = $self->{'collect'};
2987 my $gsdl_cgi = $self->{'gsdl_cgi'};
2988
2989 if ($baseaction::authentication_enabled) {
2990 # Ensure the user is allowed to edit this collection
2991 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2992 }
2993
2994 # Make sure the collection isn't locked by someone else
2995 $self->lock_collection($username, $collect);
2996
2997 $self->_erase_import_metadata(@_);
2998
2999 # Release the lock once it is done
3000 $self->unlock_collection($username, $collect);
3001
3002}
3003
3004# removes all meta with matching metaname for the specified docid from the live metadata index
3005sub _erase_live_metadata
3006{
3007 my $self = shift @_;
3008 # At present, _remove_live_metadata doesn't take metaval or metapos either and therefore has the desired effect
3009 $self->_remove_live_metadata(@_);
3010
3011}
3012
3013sub erase_live_metadata
3014{
3015 my $self = shift @_;
3016
3017 my $username = $self->{'username'};
3018 my $collect = $self->{'collect'};
3019 my $gsdl_cgi = $self->{'gsdl_cgi'};
3020
3021 if ($baseaction::authentication_enabled) {
3022 # Ensure the user is allowed to edit this collection
3023 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
3024 }
3025
3026 # Make sure the collection isn't locked by someone else
3027 $self->lock_collection($username, $collect);
3028
3029 $self->_erase_live_metadata(@_);
3030
3031 $self->unlock_collection($username, $collect);
3032}
3033
3034
3035# Was trying to reused the codes, but the functions need to be broken
3036# down more before they can be reused, otherwise there will be too
3037# much overhead and duplicate process...
3038sub insert_metadata
3039{
3040 my $self = shift @_;
3041
3042 my $username = $self->{'username'};
3043 my $collect = $self->{'collect'};
3044 my $gsdl_cgi = $self->{'gsdl_cgi'};
3045 my $infodbtype = $self->{'infodbtype'};
3046
3047 # If the import metadata and gdbm database have been updated, we
3048 # need to insert some notification to warn user that the the text
3049 # they see at the moment is not indexed and require a rebuild.
3050 my $rebuild_pending_macro = "_rebuildpendingmessage_";
3051
3052 if ($baseaction::authentication_enabled) {
3053 # Ensure the user is allowed to edit this collection
3054 $self->authenticate_user($username, $collect);
3055 }
3056
3057 # Obtain the collect and archive dir
3058 my $site = $self->{'site'};
3059 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3060 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
3061
3062 # Make sure the collection isn't locked by someone else
3063 $self->lock_collection($username, $collect);
3064
3065 # Check additional args
3066 my $docid = $self->{'d'};
3067 if (!defined($docid) || ($docid =~ m/^\s*$/)) {
3068 $gsdl_cgi->generate_error("No document id is specified: d=...");
3069 }
3070 my $metaname = $self->{'metaname'};
3071 if (!defined($metaname) || ($metaname =~ m/^\s*$/)) {
3072 $gsdl_cgi->generate_error("No metaname is specified: metadataname=...");
3073 }
3074 my $metavalue = $self->{'metavalue'};
3075 if (!defined($metavalue) || ($metavalue =~ m/^\s*$/)) {
3076 $gsdl_cgi->generate_error("No metavalue or empty metavalue is specified: metadataname=...");
3077 }
3078 # make "accumulate" the default (less destructive, as it won't actually
3079 # delete any existing values)
3080 my $metamode = "accumulate";
3081
3082 # metapos/prevmetavalue were never before used in this subroutine, so set them to undefined
3083 my $metapos = undef;
3084 my $prevmetavalue = undef;
3085
3086 #=======================================================================#
3087 # set_import_metadata [START]
3088 #=======================================================================#
3089 # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
3090 # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
3091 my $metadata_xml_file;
3092 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
3093 my $archive_doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
3094
3095 # This now stores the full pathname
3096 my $import_filename = $archive_doc_rec->{'src-file'}->[0];
3097 $import_filename = &util::placeholders_to_abspath($import_filename);
3098
3099 # figure out correct metadata.xml file [?]
3100 # Assuming the metadata.xml file is next to the source file
3101 # Note: This will not work if it is using the inherited metadata from the parent folder
3102 my ($import_tailname, $import_dirname)
3103 = File::Basename::fileparse($import_filename);
3104 my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
3105
3106 # Shane's escape characters
3107 $metavalue = pack "U0C*", unpack "C*", $metavalue;
3108 $metavalue =~ s/\,/&#44;/g;
3109 $metavalue =~ s/\:/&#58;/g;
3110 $metavalue =~ s/\|/&#124;/g;
3111 $metavalue =~ s/\(/&#40;/g;
3112 $metavalue =~ s/\)/&#41;/g;
3113 $metavalue =~ s/\[/&#91;/g;
3114 $metavalue =~ s/\\/&#92;/g;
3115 $metavalue =~ s/\]/&#93;/g;
3116 $metavalue =~ s/\{/&#123;/g;
3117 $metavalue =~ s/\}/&#125;/g;
3118 $metavalue =~ s/\"/&#34;/g;
3119 $metavalue =~ s/\`/&#96;/g;
3120 $metavalue =~ s/\n/_newline_/g;
3121
3122 # Edit the metadata.xml
3123 # Modified by Jeffrey from DL Consulting
3124 # Handle the case where there is one metadata.xml file for multiple FileSets
3125 # The XML filter needs to know whether it is in the right FileSet
3126 # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
3127 # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
3128 $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
3129 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
3130 #=======================================================================#
3131 # set_import_metadata [END]
3132 #=======================================================================#
3133
3134
3135 #=======================================================================#
3136 # set_metadata (accumulate version) [START]
3137 #=======================================================================#
3138 # To people who know $collect_tail please add some comments
3139 # Obtain path to the database
3140 my $collect_tail = $collect;
3141 $collect_tail =~ s/^.*[\/|\\]//;
3142 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
3143 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
3144
3145 # Read the docid entry
3146 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
3147
3148 # Protect the quotes
3149 $metavalue =~ s/\"/\\\"/g;
3150
3151 # Adds the pending macro
3152 my $macro_metavalue = $rebuild_pending_macro . $metavalue;
3153
3154 # If the metadata doesn't exist, create a new one
3155 if (!defined($doc_rec->{$metaname})){
3156 $doc_rec->{$metaname} = [ $macro_metavalue ];
3157 }
3158 # Else, let's acculumate the values
3159 else {
3160 push(@{$doc_rec->{$metaname}},$macro_metavalue);
3161 }
3162
3163 ## Use the dbutil set_entry method instead of assuming the database is gdbm
3164 my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
3165
3166 if ($status != 0) {
3167 # Catch error if gdbmget failed
3168 my $mess = "Failed to set metadata key: $docid\n";
3169
3170 $mess .= "PATH: $ENV{'PATH'}\n";
3171 $mess .= "Exit status: $status\n";
3172 $mess .= "System Error Message: $!\n";
3173
3174 $gsdl_cgi->generate_error($mess);
3175 }
3176 else {
3177 my $mess = "insert-metadata successful: Key[$docid]\n";
3178 $mess .= " [In metadata.xml] $metaname";
3179 $mess .= " = $metavalue\n";
3180 $mess .= " [In database] $metaname";
3181 $mess .= " = $macro_metavalue\n";
3182 $mess .= " The new text has not been indexed, rebuilding collection is required\n";
3183 $gsdl_cgi->generate_ok_message($mess);
3184 }
3185 #=======================================================================#
3186 # set_metadata (accumulate version) [END]
3187 #=======================================================================#
3188
3189 # Release the lock once it is done
3190 $self->unlock_collection($username, $collect);
3191}
3192
3193
3194
3195
3196sub inc_fldv_nminus1
3197{
3198 my $self = shift @_;
3199
3200 my $username = $self->{'username'};
3201 my $collect = $self->{'collect'};
3202 my $gsdl_cgi = $self->{'gsdl_cgi'};
3203 my $infodbtype = $self->{'infodbtype'};
3204
3205 # Obtain the collect dir
3206 my $site = $self->{'site'};
3207 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3208
3209 my $archive_dir = &util::filename_cat($collect_dir, $collect, "archives");
3210
3211 # look up additional args
3212 my $docid = $self->{'d'};
3213
3214
3215 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
3216 my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
3217
3218 # This now stores the full pathname [is this still true??]
3219 my $doc_file = $doc_rec->{'doc-file'}->[0];
3220
3221 my ($unused_doc_tailname, $doc_dirname) = File::Basename::fileparse($doc_file);
3222 my $doc_full_dirname = &util::filename_cat($archive_dir,$doc_dirname);
3223
3224 my $fldv_full_dirname = &util::filename_cat($doc_full_dirname,$FLDV_HISTORY_DIR);
3225
3226 my $had_error = 0;
3227 my $had_error_mess = undef;
3228
3229 if (-d $fldv_full_dirname) {
3230 my $fldv_filtered_dirs = &FileUtils::readDirectoryFiltered($fldv_full_dirname,undef,"^nminus-\\d+\$");
3231
3232 my @sorted_fldv_filtered_dirs = sort {
3233 my ($a_num) = ($a =~ m/(\d+)$/);
3234 my ($b_num) = ($b =~ m/(\d+)$/);
3235
3236 # sort into descending order
3237 return $b_num <=> $a_num;
3238 } @$fldv_filtered_dirs;
3239
3240 ## shuffle all the nminus-<n> folders down by one
3241
3242 foreach my $nminus_n (@sorted_fldv_filtered_dirs) {
3243
3244 my $nminus_n_full_dir = &FileUtils::filenameConcatenate($fldv_full_dirname,$nminus_n);
3245 if (-d $nminus_n_full_dir) {
3246
3247 my ($n) = ($nminus_n =~ m/(\d+)$/);
3248 my $new_n = $n + 1;
3249
3250 my $new_full_dir_plus1 = &FileUtils::filenameConcatenate($fldv_full_dirname,"nminus-$new_n");
3251
3252 my $move_ok = &FileUtils::renameDirectory($nminus_n_full_dir,$new_full_dir_plus1,
3253 { 'strict' => 1 } );
3254
3255 if (!$move_ok) {
3256 $had_error_mess = "Error: Failed to move '$nminus_n' to nminus-$new_n in $fldv_full_dirname\n";
3257 $had_error = 1;
3258 last;
3259 }
3260
3261 }
3262 else {
3263 print STDERR "Warning: skipping $nminus_n_full_dir as it is not a directory\n";
3264 }
3265 }
3266 }
3267 else {
3268 # first time asked to perform the inc-nminus-1 action for this doc,
3269 # and there is not yet even a _fldv directory!
3270 # => make the directory (and that's all that's needed at this stage)
3271 print STDERR "First time file-level document-version history has been applied to this document\n";
3272 print STDERR "Creating $fldv_full_dirname\n";
3273
3274 &FileUtils::makeDirectory($fldv_full_dirname);
3275 }
3276
3277 if (!$had_error) {
3278 ### Now need to copy everything top level in doc dir into nminus-1
3279
3280 my $nminus_1_full_dir = &FileUtils::filenameConcatenate($fldv_full_dirname,"nminus-1");
3281
3282 my $copy_ok = &FileUtils::copyFilesRefRecursive([$doc_full_dirname],$nminus_1_full_dir,
3283 { 'strict' => 1, 'exclude_filter_re' => "^$FLDV_HISTORY_DIR\$" } );
3284
3285 if (!$copy_ok) {
3286 $had_error_mess = "Error: Failed to clone document $docid to form 'nminus-1' directory in $fldv_full_dirname";
3287 $had_error = 1;
3288 }
3289 }
3290
3291 if ($had_error) {
3292 $gsdl_cgi->generate_error($had_error_mess);
3293 }
3294 else {
3295 $gsdl_cgi->generate_ok_message("Successfully incremented the File-Level Document-Version History for $docid");
3296 }
3297}
3298
3299
3300#############################################################
3301
3302
3303sub remove_metadata_array
3304{
3305 my $self = shift @_;
3306
3307 my $where = $self->{'where'};
3308 if(!$where || ($where =~ m/^\s*$/)) {
3309 $self->remove_index_metadata_array(@_); # mimic set_metadata_array for default behaviour
3310 return;
3311 }
3312
3313 my $username = $self->{'username'};
3314 my $collect = $self->{'collect'};
3315 my $gsdl_cgi = $self->{'gsdl_cgi'};
3316
3317 if ($baseaction::authentication_enabled) {
3318 # Ensure the user is allowed to edit this collection
3319 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
3320 }
3321
3322 # Not sure if the checked_chdir is necessary, since lock_collection also does a chdir
3323 # But copied code from set_metadata_array
3324 my $site = $self->{'site'};
3325 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3326 $gsdl_cgi->checked_chdir($collect_dir);
3327
3328 # Make sure the collection isn't locked by someone else
3329 $self->lock_collection($username, $collect);
3330
3331 if($where =~ m/import/) {
3332 $self->_remove_import_metadata_array(@_);
3333 }
3334 if($where =~ m/archives/) {
3335 $self->_remove_archives_metadata_array(@_);
3336 }
3337 if($where =~ m/index/) {
3338 $self->_remove_index_metadata_array(@_);
3339 }
3340 if($where =~ m/live/) {
3341 $self->_remove_live_metadata_array(@_);
3342 }
3343
3344 # Release the lock once it is done
3345 $self->unlock_collection($username, $collect);
3346}
3347
3348sub _remove_index_metadata_array
3349{
3350 my $self = shift @_;
3351
3352 my $collect = $self->{'collect'};
3353 my $gsdl_cgi = $self->{'gsdl_cgi'};
3354
3355 # Obtain the collect dir
3356 my $site = $self->{'site'};
3357 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3358
3359 # look up additional args
3360
3361 my $infodbtype = $self->{'infodbtype'};
3362
3363 my $json_str = $self->{'json'};
3364 my $doc_array = decode_json $json_str;
3365
3366
3367 my $global_status = 0;
3368 my $global_mess = "";
3369
3370 my @all_docids = ();
3371
3372 foreach my $doc_array_rec ( @$doc_array ) {
3373
3374 my $status = -1;
3375 my $docid = $doc_array_rec->{'docid'};
3376
3377 push(@all_docids,$docid);
3378
3379 my $metaname = $doc_array_rec->{'metaname'};
3380 if(defined $metaname) {
3381 # metapos can be undef and if metaval is also undef, metapos=0 will be used
3382 my $metapos = $doc_array_rec->{'metapos'};
3383 my $metavalue = $doc_array_rec->{'metavalue'};
3384 # remove-import-metadata and remove-archives-metadata recognise metamode option
3385 # but not remove-index-metadata
3386 #my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
3387
3388 $status = $self->remove_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue);
3389 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
3390 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
3391
3392 foreach my $metatable_rec ( @$metatable ) { # the subarray metatable is an array of hashmaps
3393 $metaname = $metatable_rec->{'metaname'};
3394 #my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'}; # metamode not used by remove_index_metadata
3395 my $metapos = $metatable_rec->{'metapos'} || $doc_array_rec->{'metapos'} || $self->{'metapos'} || undef; # try most-to-least specific metapos setting, and fallback on undef
3396 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
3397
3398 foreach my $metavalue ( @$metavals ) { # metavals is an array
3399 $status = $self->remove_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue); # how do we use metamode in set_meta_entry?
3400
3401 #if($metamode eq "override") { # now, having overridden the metavalue for the first,
3402 ## need to accumulate subsequent metavals for this metaname, else the just-assigned
3403 ## metavalue for this metaname will be lost
3404 #$metamode = "accumulate";
3405 #}
3406 }
3407 }
3408 }
3409
3410 if ($status != 0) {
3411 # Catch error if set infodb entry failed
3412 $global_status = $status;
3413 $global_mess .= "Failed to remove metadata key: $docid\n";
3414 $global_mess .= "Exit status: $status\n";
3415 $global_mess .= "System Error Message: $!\n";
3416 $global_mess .= "-" x 20;
3417 }
3418 }
3419
3420 if ($global_status != 0) {
3421 $global_mess .= "PATH: $ENV{'PATH'}\n";
3422 $gsdl_cgi->generate_error($global_mess);
3423 }
3424 else {
3425 my $mess = "remove-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
3426 $gsdl_cgi->generate_ok_message($mess);
3427 }
3428}
3429
3430sub remove_index_metadata_array
3431{
3432 my $self = shift @_;
3433
3434 my $username = $self->{'username'};
3435 my $collect = $self->{'collect'};
3436 my $gsdl_cgi = $self->{'gsdl_cgi'};
3437
3438 if ($baseaction::authentication_enabled) {
3439 # Ensure the user is allowed to edit this collection
3440 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
3441 }
3442
3443 # Obtain the collect dir
3444 my $site = $self->{'site'};
3445 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3446
3447 # Skip this step as lock_collection does a chdir into final destination directory anyway?
3448 $gsdl_cgi->checked_chdir($collect_dir);
3449
3450
3451 # Make sure the collection isn't locked by someone else
3452 $self->lock_collection($username, $collect);
3453
3454 $self->_remove_index_metadata_array(@_);
3455
3456 # Release the lock once it is done
3457 $self->unlock_collection($username, $collect);
3458}
3459
3460# Untested, based on also untested experimental _set_live_metadata_array
3461# TODO: How can we delete at a dbkey with a particular value or at a particular metapos?
3462# Same question for sub remove_live_metadata
3463sub _remove_live_metadata_array
3464{
3465 my $self = shift @_;
3466
3467 my $collect = $self->{'collect'};
3468 my $gsdl_cgi = $self->{'gsdl_cgi'};
3469
3470 # Obtain the collect dir
3471 my $site = $self->{'site'};
3472 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3473
3474 # look up additional args
3475 my $infodbtype = $self->{'infodbtype'};
3476 # To people who know $collect_tail please add some comments
3477 # Obtain path to the database
3478 my $collect_tail = $collect;
3479 $collect_tail =~ s/^.*[\/|\\]//;
3480 my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
3481 my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
3482
3483
3484 my $json_str = $self->{'json'};
3485 my $doc_array = decode_json $json_str;
3486
3487
3488 my $global_status = 0;
3489 my $global_mess = "";
3490
3491 my @all_docids = ();
3492
3493
3494 foreach my $doc_array_rec ( @$doc_array ) {
3495
3496 my $status = -1;
3497 my $docid = $doc_array_rec->{'docid'};
3498
3499 push(@all_docids,$docid);
3500
3501 my $metaname = $doc_array_rec->{'metaname'};
3502 if(defined $metaname) {
3503 my $dbkey = "$docid.$metaname";
3504
3505 # Remove the key
3506 #my $metavalue = $doc_array_rec->{'metavalue'};
3507 #my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
3508 my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\"";
3509 $status = system($cmd);
3510
3511 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
3512 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
3513 foreach my $metatable_rec ( @$metatable ) {
3514 $metaname = $metatable_rec->{'metaname'};
3515 my $dbkey = "$docid.$metaname";
3516
3517 my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\"";
3518 $status = system($cmd);
3519 #my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
3520 #foreach my $metavalue ( @$metavals ) {
3521 #my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
3522 #$status = system($cmd);
3523 #}
3524 }
3525
3526 }
3527
3528 if ($status != 0) {
3529 # Catch error if gdbmdel failed
3530 $global_status = $status;
3531 $global_mess .= "Failed to delete metadata key: $dbkey\n"; # $dbkey
3532 $global_mess .= "Exit status: $status\n";
3533 $global_mess .= "System Error Message: $!\n";
3534 $global_mess .= "-" x 20;
3535 }
3536 }
3537
3538 if ($global_status != 0) {
3539 $global_mess .= "PATH: $ENV{'PATH'}\n";
3540 $gsdl_cgi->generate_error($global_mess);
3541 }
3542 else {
3543 my $mess = "remove-live-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
3544 $gsdl_cgi->generate_ok_message($mess);
3545 }
3546}
3547
3548sub remove_live_metadata_array
3549{
3550 my $self = shift @_;
3551
3552 my $username = $self->{'username'};
3553 my $collect = $self->{'collect'};
3554 my $gsdl_cgi = $self->{'gsdl_cgi'};
3555
3556 if ($baseaction::authentication_enabled) {
3557 # Ensure the user is allowed to edit this collection
3558 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
3559 }
3560
3561 # Obtain the collect dir
3562 my $site = $self->{'site'};
3563 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3564
3565 $gsdl_cgi->checked_chdir($collect_dir);
3566
3567 # Make sure the collection isn't locked by someone else
3568 $self->lock_collection($username, $collect);
3569
3570 $self->_remove_live_metadata_array(@_);
3571
3572 # Release the lock once it is done
3573 $self->unlock_collection($username, $collect);
3574}
3575
3576
3577sub remove_import_metadata_array
3578{
3579 my $self = shift @_;
3580
3581 my $username = $self->{'username'};
3582 my $collect = $self->{'collect'};
3583 my $gsdl_cgi = $self->{'gsdl_cgi'};
3584
3585 if ($baseaction::authentication_enabled) {
3586 # Ensure the user is allowed to edit this collection
3587 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
3588 }
3589
3590 # Obtain the collect dir
3591 my $site = $self->{'site'};
3592 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3593
3594 $gsdl_cgi->checked_chdir($collect_dir);
3595
3596 # Make sure the collection isn't locked by someone else
3597 $self->lock_collection($username, $collect);
3598
3599 $self->_remove_import_metadata_array(@_);
3600
3601 # Release the lock once it is done
3602 $self->unlock_collection($username, $collect);
3603
3604}
3605
3606
3607sub _remove_import_metadata_array
3608{
3609 my $self = shift @_;
3610
3611 my $collect = $self->{'collect'};
3612 my $gsdl_cgi = $self->{'gsdl_cgi'};
3613
3614 # Obtain the collect dir
3615 my $site = $self->{'site'};
3616 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3617
3618 # look up additional args
3619
3620 my $infodbtype = $self->{'infodbtype'};
3621
3622 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
3623 my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
3624
3625 my $json_str = $self->{'json'};
3626 my $doc_array = decode_json $json_str;
3627
3628 #my $global_status = 0;
3629 #my $global_mess = "";
3630
3631 my @all_docids = ();
3632
3633 foreach my $doc_array_rec ( @$doc_array )
3634 {
3635 my $status = -1;
3636 my $docid = $doc_array_rec->{'docid'};
3637
3638 my ($docid_root,$docid_secnum);
3639 if(defined $docid) {
3640 ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
3641 # as yet no support for setting or removing subsection metadata in metadata.xml
3642 if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
3643 $gsdl_cgi->generate_message("*** docid: $docid. No support yet for deleting import metadata at subsections' level.\n");
3644 next; # skip this docid in for loop
3645 }
3646 }
3647
3648 push(@all_docids,$docid); # docid_root rather
3649
3650 my $metaname = $doc_array_rec->{'metaname'};
3651 if (defined $metaname) {
3652 my $metapos = $doc_array_rec->{'metapos'} || $self->{'metapos'};
3653 my $metavalue = $doc_array_rec->{'metavalue'}; #|| $self->{'metavalue'};
3654 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'} || undef; # see set_import_meta_array for fallback
3655
3656 $self->remove_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid_root, $metaname, $metapos, $metavalue, $metamode); # at this point, docid_root = docid
3657
3658 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
3659 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
3660
3661 foreach my $metatable_rec ( @$metatable ) {
3662 $metaname = $metatable_rec->{'metaname'};
3663 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'} || undef;
3664
3665 my $metapositions = $metatable_rec->{'metapositions'}; # a sub-subarray
3666 if(defined $metapositions) {
3667 foreach my $metapos ( @$metapositions ) {
3668 $metavalue = undef;
3669
3670 $self->remove_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid_root, $metaname, $metapos, $metavalue, $metamode); # at this point, docid_root = docid
3671
3672 #if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
3673 # need to accumulate subsequent metavals for this metaname, else the just-assigned
3674 # metavalue for this metaname will be lost
3675 #$metamode = "accumulate";
3676 #}
3677 }
3678 }
3679 else {
3680 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
3681 next unless defined $metavals;
3682 foreach my $metavalue ( @$metavals ) {
3683 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
3684 $metapos = undef;
3685
3686 $self->remove_import_metadata_entry($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid_root, $metaname, $metapos, $metavalue, $metamode); # at this point, docid_root = docid
3687
3688 #if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
3689 # need to accumulate subsequent metavals for this metaname, else the just-assigned
3690 # metavalue for this metaname will be lost
3691 #$metamode = "accumulate";
3692 #}
3693 }
3694 }
3695 }
3696 }
3697 }
3698
3699
3700 # always a success message, as any failure would have caused a call to die within remove_import_metadata_entry
3701 my $mess = "remove-import-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
3702 $gsdl_cgi->generate_ok_message($mess);
3703}
3704
3705
3706sub _remove_archives_metadata_array
3707{
3708 my $self = shift @_;
3709
3710 my $collect = $self->{'collect'};
3711 my $gsdl_cgi = $self->{'gsdl_cgi'};
3712
3713 # Obtain the collect dir
3714 my $site = $self->{'site'};
3715 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3716
3717 # look up additional args
3718
3719 my $infodbtype = $self->{'infodbtype'};
3720
3721 my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
3722
3723 my $json_str = $self->{'json'};
3724 my $doc_array = decode_json $json_str;
3725
3726
3727 my $global_status = 0;
3728 my $global_mess = "";
3729
3730 my @all_docids = ();
3731
3732 foreach my $doc_array_rec ( @$doc_array ) {
3733 my $status = -1;
3734 my $docid = $doc_array_rec->{'docid'};
3735 my $dv = $doc_array_rec->{'dv'};
3736
3737 push(@all_docids,$docid);
3738
3739 my $metaname = $doc_array_rec->{'metaname'};
3740 if(defined $metaname) {
3741
3742 my $metapos = $doc_array_rec->{'metapos'};
3743 my $metavalue = $doc_array_rec->{'metavalue'};
3744 my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
3745
3746 $status = $self->remove_archives_metadata_entry($gsdl_cgi,$archive_dir,$infodbtype,
3747 $docid,$dv, $metaname,$metapos,$metavalue,$metamode);
3748
3749 } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
3750 my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
3751
3752 foreach my $metatable_rec ( @$metatable ) {
3753 $metaname = $metatable_rec->{'metaname'};
3754 my $metamode = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
3755 my $metapositions = $metatable_rec->{'metapositions'}; # a sub-subarray
3756 if(defined $metapositions) {
3757 foreach my $metapos ( @$metapositions ) {
3758 $metavalue = undef;
3759
3760 $self->remove_archives_metadata_entry($gsdl_cgi, $archive_dir, $infodbtype,
3761 $docid,$dv, $metaname, $metapos, $metavalue, $metamode);
3762
3763 #if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
3764 # need to accumulate subsequent metavals for this metaname, else the just-assigned
3765 # metavalue for this metaname will be lost
3766 #$metamode = "accumulate";
3767 #}
3768 }
3769 }
3770 else {
3771 my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
3772 next unless defined $metavals;
3773 foreach my $metavalue ( @$metavals ) {
3774 $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
3775 $metapos = undef;
3776
3777 $status = $self->remove_archives_metadata_entry($gsdl_cgi,$archive_dir,$infodbtype,
3778 $docid,$dv, $metaname,$metapos,$metavalue,$metamode);
3779 #if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
3780 # need to accumulate subsequent metavals for this metaname, else the just-assigned
3781 # metavalue for this metaname will be lost
3782 #$metamode = "accumulate";
3783 #}
3784 }
3785 }
3786 }
3787 }
3788
3789 if ($status != 0) {
3790 # Catch error if set infodb entry failed
3791 $global_status = $status;
3792 $global_mess .= "Failed to remove archives metadata key: $docid\n";
3793 $global_mess .= "Exit status: $status\n";
3794 $global_mess .= "System Error Message: $!\n";
3795 $global_mess .= "-" x 20 . "\n";
3796 }
3797 }
3798
3799 if ($global_status != 0) {
3800 $global_mess .= "PATH: $ENV{'PATH'}\n";
3801 $gsdl_cgi->generate_error($global_mess);
3802 }
3803 else {
3804 my $mess = "remove-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
3805 $gsdl_cgi->generate_ok_message($mess);
3806 }
3807}
3808
3809sub remove_archives_metadata_array
3810{
3811 my $self = shift @_;
3812
3813 my $username = $self->{'username'};
3814 my $collect = $self->{'collect'};
3815 my $gsdl_cgi = $self->{'gsdl_cgi'};
3816
3817 if ($baseaction::authentication_enabled) {
3818 # Ensure the user is allowed to edit this collection
3819 $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
3820 }
3821
3822 # Obtain the collect dir
3823 my $site = $self->{'site'};
3824 my $collect_dir = $gsdl_cgi->get_collection_dir($site);
3825
3826 $gsdl_cgi->checked_chdir($collect_dir);
3827
3828 # Make sure the collection isn't locked by someone else
3829 $self->lock_collection($username, $collect);
3830
3831 $self->_remove_archives_metadata_array(@_);
3832
3833 # Release the lock once it is done
3834 $self->unlock_collection($username, $collect);
3835}
3836
3837
3838##################################### END REMOVE ARRAY METHODS #################
3839
3840# not returning 1; here since this file is conditionally included by metadataction.pm
3841# and not otherwise meant to be used on its own
3842
Note: See TracBrowser for help on using the repository browser.