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

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

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