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

Last change on this file since 28252 was 28252, checked in by davidb, 11 years ago

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