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

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