Context Navigation

metadataaction.pm @ 29086

Revision 29086, 119.3 KB (checked in by kjdon, 6 years ago)
need to decode prevmetavalue in same way as metavalue. clear all metadata only if metapos AND metavalue are empty

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/main/trunk/greenstone2/perllib/cgiactions/metadataaction.pm @ 29086

Download in other formats: