Context Navigation

metadataaction.pm@ 31589

Last change on this file since 31589 was 31589, checked in by ak19, 7 years ago

Bugfixes I think. Noticed that remove-archives-meta was removing the existing two metavalues for a metaname instead of a specific one despite being given a specific metavalue to remove. This seems to have happened because metapos was not undefined yet did not have a proper value (being the empty string or a string of empty chars), and so metapos was being set to 0. In that case the metavalue at metapos 0 AND the metavalue specified were both being removed. I then noticed the same issue going on with remove-index-meta too, and then noticed that set-index-meta wasn't working the way I expected it to either. All of these had to do with incoming args like metapos and metavalue only being tested for undefinedness rather than being tested for whether they were defined yet consisted of a string of one or more empty spaces.

File size: 121.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: