root/main/trunk/greenstone2/perllib/cgiactions/modmetadataaction.pm @ 32077

Revision 32077, 93.4 KB (checked in by kjdon, 2 years ago)

Removed debugging, and added some comments.

Line 
1##########################################################################
2#
3# modmetadataaction.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# This is a submodule of metadataaction.pm. It is loaded conditionally
27# upon having the permissions to modify (not just get) metadata.
28# With sufficient permissions, these additional subroutines should be made
29# available to metadataaction.pm
30
31# See http://www.perlmonks.org/?node_id=881761 for splitting module into multiple files
32# and how variables declared with 'our' are used there.
33
34package metadataaction;
35
36use strict;
37
38use cgiactions::baseaction;
39
40use dbutil;
41use ghtml;
42
43use JSON;
44
45
46$metadataaction::modmeta_action_table = #OR: our $modmeta_action_table =
47{
48    #SET METHODS
49    "set-live-metadata" => {
50        'compulsory-args' => [ "d", "metaname", "metavalue" ],
51        'optional-args'   => [ ] },
52
53    "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
54        'compulsory-args' => [ "metaname", "metavalue" ],
55        'optional-args'   => [ "where", "metapos", "metamode", "prevmetavalue", "d", "f" ] },
56
57    "set-index-metadata" => {
58        'compulsory-args' => [ "d", "metaname", "metavalue" ],
59        'optional-args'   => [ "metapos", "metamode" ] },
60
61    "set-archives-metadata" => {
62        'compulsory-args' => [ "d", "metaname", "metavalue" ],
63        'optional-args'   => [ "metapos", "metamode", "prevmetavalue" ] }, # metamode can be "accumulate", "override",
64   
65    "set-import-metadata" => {
66        'compulsory-args' => [ "metaname", "metavalue" ],
67        '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
68                 
69    #SET METHODS (ARRAY)
70    "set-metadata-array" => {
71        'compulsory-args' => [ "where", "json" ],
72        'optional-args'   => [ ],
73        'help-string' => [
74        '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"}]',
75       
76        '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"}]' ] },
77
78# The same examples rewritten for when running the metadata-server.pl script from the commandline:
79
80# 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\"}]",
81       
82# 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\"}]"
83                     
84    "set-archives-metadata-array" => {
85        'compulsory-args' => [ "json" ],
86        'optional-args'   => [ ] },
87       
88    "set-import-metadata-array" => {
89        'compulsory-args' => [ "json" ],
90        'optional-args'   => [ ] },
91
92    "set-index-metadata-array" => {
93        'compulsory-args' => [ "json" ],
94        'optional-args'   => [ ] },
95   
96    "set-live-metadata-array" => {
97        'compulsory-args' => [ "json" ],
98        'optional-args'   => [ ] },
99       
100    #REMOVE METHODS
101    "remove-import-metadata" => {
102        'compulsory-args' => [ "d", "metaname" ], #TODO: add f argument
103        'optional-args'   => [ "metapos", "metavalue", "metamode" ] }, # only provide metapos arg for SIMPLE collections.
104# 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.
105                     
106    "remove-archives-metadata" => {
107        'compulsory-args' => [ "d", "metaname" ], #TODO: add f argument
108        'optional-args'   => [ "metapos", "metavalue", "metamode" ] },
109
110    "remove-live-metadata" => {
111        'compulsory-args' => [ "d", "metaname" ],
112        'optional-args'   => [ ] },
113
114    "remove-index-metadata" => {
115        'compulsory-args' => [ "d", "metaname" ],
116        'optional-args'   => [ "metapos", "metavalue" ] },
117
118    "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
119        'compulsory-args' => [ "d", "metaname" ],
120        '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
121
122    #INSERT METHODS
123    "insert-metadata" => {
124        'compulsory-args' => [ "d", "metaname", "metavalue" ],
125        'optional-args'   => [ ] }
126};
127
128
129sub _set_live_metadata
130{
131    my $self = shift @_;
132
133    my $collect   = $self->{'collect'};
134    my $gsdl_cgi  = $self->{'gsdl_cgi'};
135    #my $gsdlhome  = $self->{'gsdlhome'};
136    my $infodbtype = $self->{'infodbtype'};
137
138    # Obtain the collect dir
139    my $site = $self->{'site'};
140    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
141    ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
142
143
144    # look up additional args
145    my $docid     = $self->{'d'};
146    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
147      $gsdl_cgi->generate_error("No docid (d=...) specified."); # generates error and dies
148    }
149    my $metavalue = $self->{'metavalue'};
150
151    # Generate the dbkey   
152    my $metaname  = $self->{'metaname'};
153    my $dbkey = "$docid.$metaname";
154
155    # To people who know $collect_tail please add some comments
156    # Obtain path to the database
157    my $collect_tail = $collect;
158    $collect_tail =~ s/^.*[\/|\\]//;
159    my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
160    my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
161
162    # Set the new value
163    my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
164    my $status = system($cmd);
165    if ($status != 0) {
166        # Catch error if gdbmget failed
167    my $mess = "Failed to set metadata key: $dbkey\n";
168
169    $mess .= "PATH: $ENV{'PATH'}\n";
170    $mess .= "cmd = $cmd\n";
171    $mess .= "Exit status: $status\n";
172    $mess .= "System Error Message: $!\n";
173
174    $gsdl_cgi->generate_error($mess);
175    }
176    else {
177    $gsdl_cgi->generate_ok_message("set-live-metadata successful: Key[$metaname]=$metavalue");
178    }
179
180    #return $status; # in case calling functions have any further use for this
181}
182
183sub set_live_metadata
184{
185    my $self = shift @_;
186
187    my $username  = $self->{'username'};
188    my $collect   = $self->{'collect'};
189    my $gsdl_cgi  = $self->{'gsdl_cgi'};
190 
191    if ($baseaction::authentication_enabled) {
192    # Ensure the user is allowed to edit this collection   
193    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
194    }
195
196    # Make sure the collection isn't locked by someone else
197    $self->lock_collection($username, $collect);
198
199    $self->_set_live_metadata(@_);
200
201    # Release the lock once it is done
202    $self->unlock_collection($username, $collect);
203}
204
205sub set_index_metadata_entry
206{
207    print STDERR "1\n";
208    my $self = shift @_;
209    my ($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue) = @_;
210   
211    # To people who know $collect_tail please add some comments
212    # Obtain path to the database
213    my $collect_tail = $collect;
214    $collect_tail =~ s/^.*[\/|\\]//;
215    my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
216    my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
217   
218    print STDERR "2\n";
219#   print STDERR "**** infodb file path = $infodb_file_path\n";
220#   print STDERR "***** infodb type = $infodbtype\n";
221   
222    # Read the docid entry
223    my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
224   
225    # Set the metadata value
226    if (defined $metapos) {
227    print STDERR "3\n";
228    # if metamode=accumulate AND metapos, warn user and then use metapos
229    if (defined $metamode && $metamode eq "accumulate") {
230        print STDERR "**** Warning: metamode is set to accumulate yet metapos is also provided for $docid\n";
231        print STDERR "**** Proceeding by using metapos\n";
232    }
233    $doc_rec->{$metaname}->[$metapos] = $metavalue;
234    }
235    elsif (defined $prevmetavalue) {
236    print STDERR "4\n";
237        my $array = $doc_rec->{$metaname};
238        my $length = @$array;
239
240        my $found = 0;
241        for (my $i = 0; $i < $length; $i++){
242            if(defined $doc_rec->{$metaname}->[$i] && $doc_rec->{$metaname}->[$i] eq $prevmetavalue){
243                $doc_rec->{$metaname}->[$i] = $metavalue;
244                $found = 1;
245                last;               
246            }
247        }
248
249        if($found == 0){
250            $doc_rec->{$metaname} = [ $metavalue ];
251        }
252    }
253    elsif (defined $metamode && $metamode eq "override") {
254    print STDERR "5\n";
255    $doc_rec->{$metaname} = [ $metavalue ];
256    }
257    else { # default for index was to override, but because accumulate is less destructive,
258    # and because accumulate is the default for archives and import, that's the new default for index too
259    print STDERR "6\n";
260    if(defined $doc_rec->{$metaname}) {
261        push(@{$doc_rec->{$metaname}}, $metavalue); # accumulate the value for that metaname
262    } else {
263        $doc_rec->{$metaname} = [ $metavalue ];
264    }
265    }
266    print STDERR "6\n";
267 
268    my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path,$docid,$doc_rec);
269   
270    return $status;
271   
272}
273
274sub _set_import_metadata
275{
276    my $self = shift @_;
277
278    my $collect   = $self->{'collect'};
279    my $gsdl_cgi  = $self->{'gsdl_cgi'};
280    my $infodbtype = $self->{'infodbtype'};
281#    my $gsdlhome  = $self->{'gsdlhome'};
282     
283    # Obtain the collect and archive dir   
284    my $site = $self->{'site'};
285    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
286    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
287    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
288   
289    # look up additional args
290    # want either d= or f=
291    my $docid  = $self->{'d'};
292    my ($docid_root,$docid_secnum);
293    if(defined $docid) {   
294    ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);   
295    # as yet no support for setting subsection metadata in metadata.xml
296    if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
297        $gsdl_cgi->generate_message("*** No support yet for setting import metadata at subsections level.\n");
298        return;
299    }
300    }
301
302    my $import_file  = $self->{'f'};
303    if ((!defined $docid || $docid =~ m/^\s*$/) && (!defined $import_file || $import_file =~ m/^\s*$/)) {
304    $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified."); # at least d or f must be specified
305    }
306
307    # Get the parameters and set default mode to "accumulate"
308    my $metaname   = $self->{'metaname'};
309    my $metavalue  = $self->{'metavalue'};
310##    $metavalue =~ s/&amp;lt;(.*?)&amp;gt;/<$1>/g;
311    $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
312   
313    my $metamode   = $self->{'metamode'};
314    if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
315    # make "accumulate" the default (less destructive, as it won't actually
316    # delete any existing values)
317    $metamode = "accumulate";
318    }
319
320    # adding metapos and prevmetavalue support to import_metadata subroutines
321    my $metapos   = $self->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
322    my $prevmetavalue = $self->{'prevmetavalue'};
323    $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
324    $prevmetavalue = undef if(defined $prevmetavalue && ($prevmetavalue =~ m/^\s*$/));
325
326    my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
327    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
328
329    my $mess = "set-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
330    $mess .= "  $metaname";
331    $mess .= " = $metavalue";
332    $mess .= " ($metamode)\n";
333
334    $gsdl_cgi->generate_ok_message($mess);
335
336    #return $status; # in case calling functions have any further use for this
337}
338
339# the version of set_index_meta that doesn't do authentication
340sub _set_archives_metadata
341{
342    my $self = shift @_;
343
344    my $collect   = $self->{'collect'};
345    my $gsdl_cgi  = $self->{'gsdl_cgi'};
346    my $infodbtype = $self->{'infodbtype'};
347   
348    # Obtain the collect and archive dir   
349    my $site = $self->{'site'};
350    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
351    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
352
353    # look up additional args
354    my $docid  = $self->{'d'};
355    my $metaname   = $self->{'metaname'};
356    my $metavalue  = $self->{'metavalue'};
357    my $prevmetavalue = $self->{'prevmetavalue'};
358   
359    my $metapos    = $self->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
360                                  # Don't append "|| undef", since if metapos=0 it will then be set to undef
361
362    $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
363    $prevmetavalue = undef if(defined $prevmetavalue && ($prevmetavalue =~ m/^\s*$/));
364
365    my $metamode   = $self->{'metamode'};
366    if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
367    # make "accumulate" the default (less destructive, as it won't actually
368    # delete any existing values)
369    $metamode = "accumulate";
370    }
371
372    my $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,$docid,
373                $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
374   
375    if ($status == 0) {
376    my $mess = "set-archives-metadata successful: Key[$docid]\n";
377    $mess .= "  $metaname";
378    $mess .= "->[$metapos]" if (defined $metapos);
379    $mess .= " = $metavalue";
380    $mess .= " ($metamode)\n";
381   
382    $gsdl_cgi->generate_ok_message($mess); 
383    }
384    else {
385    my $mess .= "Failed to set archives metadata key: $docid\n";
386    $mess .= "Exit status: $status\n";
387    if(defined $self->{'error_msg'}) {
388        $mess .= "Error Message: $self->{'error_msg'}\n";
389    } else {
390        $mess .= "System Error Message: $!\n";
391    }
392    $mess .= "-" x 20 . "\n";
393   
394    $gsdl_cgi->generate_error($mess);
395    }
396
397    #return $status; # in case calling functions have any further use for this
398}
399
400
401# the version of set_index_meta that doesn't do authentication
402sub _set_index_metadata
403{
404    print STDERR "START SET INDEX METADATA\n";
405    my $self = shift @_;
406
407    my $collect   = $self->{'collect'};
408    my $gsdl_cgi  = $self->{'gsdl_cgi'};
409
410    my $site = $self->{'site'};
411    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
412
413    # look up additional args
414    my $docid     = $self->{'d'};
415    my $metaname  = $self->{'metaname'};
416    my $metapos   = $self->{'metapos'}; # undef has meaning
417    my $metavalue = $self->{'metavalue'};
418    my $infodbtype = $self->{'infodbtype'};
419    my $metamode  = $self->{'metamode'};
420    my $prevmetavalue = $self->{'prevmetavalue'};
421
422    $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
423    $prevmetavalue = undef if(defined $prevmetavalue && ($prevmetavalue =~ m/^\s*$/));
424
425    print STDERR "SETTING INDEX METADATA ENTRY\n";
426    my $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
427    print STDERR "DONE SETTING INDEX METADATA ENTRY\n";
428    if ($status != 0) {
429        # Catch error if set infodb entry failed
430    my $mess = "Failed to set metadata key: $docid\n";
431   
432    $mess .= "PATH: $ENV{'PATH'}\n";
433    $mess .= "Exit status: $status\n";
434    $mess .= "System Error Message: $!\n";
435   
436    $gsdl_cgi->generate_error($mess);
437    }
438    else {
439    my $mess = "set-index-metadata successful: Key[$docid]\n";
440    $mess .= "  $metaname";
441    $mess .= "->[$metapos]" if (defined $metapos);
442    $mess .= " = $metavalue\n";
443   
444    $gsdl_cgi->generate_ok_message($mess);
445    }
446
447    print STDERR "END SET INDEX METADATA\n";
448    #return $status; # in case calling functions have any further use for this
449}
450
451sub set_index_metadata
452{
453    my $self = shift @_;
454
455    my $username  = $self->{'username'};
456    my $collect   = $self->{'collect'};
457    my $gsdl_cgi  = $self->{'gsdl_cgi'};
458    #my $gsdlhome  = $self->{'gsdlhome'};
459
460    if ($baseaction::authentication_enabled) {
461    # Ensure the user is allowed to edit this collection   
462    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
463    }
464
465    my $site = $self->{'site'};
466    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
467   
468    $gsdl_cgi->checked_chdir($collect_dir);
469
470    # Obtain the collect dir
471    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
472
473    # Make sure the collection isn't locked by someone else
474    $self->lock_collection($username, $collect);
475
476    $self->_set_index_metadata(@_);
477   
478    # Release the lock once it is done
479    $self->unlock_collection($username, $collect);
480}
481
482# call this to set the metadata for a combination of dirs archives, import or index, or live
483# if none specified, defaults to index which was the original behaviour of set_metadata.
484sub set_metadata
485{
486    my $self = shift @_;
487
488    # Testing that not defining a variable, setting it to "" or to "  " all return false
489    # >perl -e 'my $whichdirs=""; if($whichdirs) {print "$whichdirs\n"};'
490
491    my $where = $self->{'where'};
492    if(!$where || ($where =~ m/^\s*$/)) {   
493    $self->set_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
494    return;
495    }
496
497    # authenticate and lock collection once, even if processing multiple dirs
498    my $username  = $self->{'username'};
499    my $collect   = $self->{'collect'};
500    my $gsdl_cgi  = $self->{'gsdl_cgi'};
501   
502    if ($baseaction::authentication_enabled) {
503    # Ensure the user is allowed to edit this collection   
504    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
505    }
506   
507    if($where =~ m/index/) {
508    my $site = $self->{'site'};
509    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
510    $gsdl_cgi->checked_chdir($collect_dir);
511    }
512
513    # Make sure the collection isn't locked by someone else
514    $self->lock_collection($username, $collect);
515
516
517    # now at last can set the metadata. $where can specify multiple
518    # $where is of the form: import|archives|index, or a subset thereof
519
520    #my @whichdirs = split('\|', $where);
521
522    # just check whether $where contains import/archives/index/live in turn, and
523    # for each case, process it accordingly
524    if($where =~ m/import/) {
525    $self->_set_import_metadata(@_);       
526    }
527
528    if($where =~ m/archives/) {
529
530    # look up docID arg which is optional to set_metadata because it's optional
531    # to set_import, but which is compulsory to set_archives_metadata
532    my $docid     = $self->{'d'};
533    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
534        $gsdl_cgi->generate_error("No docid (d=...) specified."); # generates error and dies
535    }
536    # we have a docid, so can set archives meta
537    $self->_set_archives_metadata(@_); 
538    }
539
540    if($where =~ m/index/) {
541   
542    # look up docID arg which is optional to set_metadata because it's optional
543    # to set_import, but which is compulsory to set_archives_metadata
544    my $docid     = $self->{'d'};
545    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
546        $gsdl_cgi->generate_error("No docid (d=...) specified.");
547    }
548    # we have a docid, so can set index meta
549    $self->_set_index_metadata(@_);
550    }   
551
552    if($where =~ m/live/) {
553    $self->_set_live_metadata(@_); # docid param, d, is compulsory, but is checked for in subroutine
554    }
555
556    # Release the lock once it is done
557    $self->unlock_collection($username, $collect);
558}
559
560sub set_metadata_array
561{
562    my $self = shift @_;
563
564    my $where = $self->{'where'};
565    if(!$where || ($where =~ m/^\s*$/)) {   
566    $self->set_index_metadata_array(@_); # default behaviour is the full version of set_index_meta_array
567    return;
568    }
569
570    my $username  = $self->{'username'};
571    my $collect   = $self->{'collect'};
572    my $gsdl_cgi  = $self->{'gsdl_cgi'};
573
574    if ($baseaction::authentication_enabled) {
575    # Ensure the user is allowed to edit this collection
576    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
577    }
578
579    # Not sure if the checked_chdir is necessary, since lock_collection also does a chdir
580    # But including the stmt during this code reorganisation to preserve as-is what used to happen
581    my $site = $self->{'site'};
582    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
583    $gsdl_cgi->checked_chdir($collect_dir);
584
585    # Make sure the collection isn't locked by someone else
586    $self->lock_collection($username, $collect);
587
588    if($where =~ m/import/) {
589    $self->_set_import_metadata_array(@_);
590    }
591    if($where =~ m/archives/) {
592    $self->_set_archives_metadata_array(@_);
593    }
594    if($where =~ m/index/) {
595    $self->_set_index_metadata_array(@_);
596    }
597    if($where =~ m/live/) {
598        $self->_set_live_metadata_array(@_);
599    }
600
601    # Release the lock once it is done
602    $self->unlock_collection($username, $collect);
603}
604
605sub _set_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   
615    # look up additional args
616   
617    my $infodbtype = $self->{'infodbtype'};
618   
619    my $json_str      = $self->{'json'};
620    my $doc_array = decode_json $json_str;
621   
622   
623    my $global_status = 0;
624    my $global_mess = "";
625   
626    my @all_docids = ();
627   
628    foreach my $doc_array_rec ( @$doc_array ) {
629   
630    my $status = -1;
631    my $docid     = $doc_array_rec->{'docid'};
632   
633    push(@all_docids,$docid);
634
635    my $metaname  = $doc_array_rec->{'metaname'};
636    if(defined $metaname) {
637        my $metapos   = $doc_array_rec->{'metapos'}; # can legitimately be undef
638        my $metavalue = $doc_array_rec->{'metavalue'};
639        my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
640
641        $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode);
642    } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
643        my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
644       
645        foreach my $metatable_rec ( @$metatable ) { # the subarray metatable is an array of hashmaps
646        $metaname  = $metatable_rec->{'metaname'};
647        my $metamode  = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
648        my $metapos = undef;
649        my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
650
651        foreach my $metavalue ( @$metavals ) { # metavals is an array
652            $status = $self->set_index_metadata_entry($collect_dir,$collect,$infodbtype,$docid,$metaname,$metapos,$metavalue,$metamode); # how do we use metamode in set_meta_entry?
653            if($metamode eq "override") { # now, having overridden the metavalue for the first,
654            # need to accumulate subsequent metavals for this metaname, else the just-assigned
655            # metavalue for this metaname will be lost
656            $metamode = "accumulate";
657            }
658        }           
659        }
660    }
661   
662    if ($status != 0) {
663        # Catch error if set infodb entry failed
664        $global_status = $status;
665        $global_mess .= "Failed to set metadata key: $docid\n";
666        $global_mess .= "Exit status: $status\n";
667        $global_mess .= "System Error Message: $!\n";
668        $global_mess .= "-" x 20;
669    }
670    }
671   
672    if ($global_status != 0) {
673    $global_mess .= "PATH: $ENV{'PATH'}\n";
674    $gsdl_cgi->generate_error($global_mess);
675    }
676    else {
677    my $mess = "set-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
678    $gsdl_cgi->generate_ok_message($mess);
679    }
680}
681
682sub set_index_metadata_array
683{
684    my $self = shift @_;
685
686    my $username  = $self->{'username'};
687    my $collect   = $self->{'collect'};
688    my $gsdl_cgi  = $self->{'gsdl_cgi'};
689#    my $gsdlhome  = $self->{'gsdlhome'};
690
691    if ($baseaction::authentication_enabled) {
692    # Ensure the user is allowed to edit this collection   
693    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
694    }
695
696    my $site = $self->{'site'};
697    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
698   
699    $gsdl_cgi->checked_chdir($collect_dir);
700
701    # Obtain the collect dir
702    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
703
704    # Make sure the collection isn't locked by someone else
705    $self->lock_collection($username, $collect);
706
707    $self->_set_index_metadata_array(@_);
708
709    # Release the lock once it is done
710    $self->unlock_collection($username, $collect);
711}
712
713# experimental, newly added in and untested
714sub _set_live_metadata_array
715{
716    my $self = shift @_;
717
718    my $collect   = $self->{'collect'};
719    my $gsdl_cgi  = $self->{'gsdl_cgi'};
720
721    my $site = $self->{'site'};
722    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
723
724   
725    # look up additional args
726    my $infodbtype = $self->{'infodbtype'};
727    # To people who know $collect_tail please add some comments
728    # Obtain path to the database
729    my $collect_tail = $collect;
730    $collect_tail =~ s/^.*[\/|\\]//;
731    my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
732    my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
733
734   
735    my $json_str      = $self->{'json'};
736    my $doc_array = decode_json $json_str;
737   
738   
739    my $global_status = 0;
740    my $global_mess = "";
741   
742    my @all_docids = ();
743
744
745    foreach my $doc_array_rec ( @$doc_array ) {
746   
747    my $status = -1;
748    my $docid     = $doc_array_rec->{'docid'};
749
750    push(@all_docids,$docid);
751
752    my $metaname  = $doc_array_rec->{'metaname'};
753    if(defined $metaname) {
754        my $dbkey = "$docid.$metaname";
755        my $metavalue = $doc_array_rec->{'metavalue'};
756
757        # Set the new value
758        my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
759        $status = system($cmd);
760
761    } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
762        my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
763        foreach my $metatable_rec ( @$metatable ) {
764        $metaname  = $metatable_rec->{'metaname'};
765        my $dbkey = "$docid.$metaname";
766
767        my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
768        foreach my $metavalue ( @$metavals ) {
769             my $cmd = "gdbmset \"$infodb_file_path\" \"$dbkey\" \"$metavalue\"";
770             $status = system($cmd);
771        }
772        }
773       
774    }
775
776    if ($status != 0) {
777        # Catch error if gdbmget failed
778        $global_status = $status;
779        $global_mess .= "Failed to set metadata key: $docid\n"; # $dbkey
780        $global_mess .= "Exit status: $status\n";
781        $global_mess .= "System Error Message: $!\n";
782        $global_mess .= "-" x 20;
783    }
784    }
785   
786    if ($global_status != 0) {
787    $global_mess .= "PATH: $ENV{'PATH'}\n";
788    $gsdl_cgi->generate_error($global_mess);
789    }
790    else {
791    my $mess = "set-live-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
792    $gsdl_cgi->generate_ok_message($mess);
793    }
794}
795
796sub set_live_metadata_array
797{
798    my $self = shift @_;
799
800    my $username  = $self->{'username'};
801    my $collect   = $self->{'collect'};
802    my $gsdl_cgi  = $self->{'gsdl_cgi'};
803
804    if ($baseaction::authentication_enabled) {
805    # Ensure the user is allowed to edit this collection   
806    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
807    }
808
809    my $site = $self->{'site'};
810    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
811   
812    $gsdl_cgi->checked_chdir($collect_dir);
813
814    # Make sure the collection isn't locked by someone else
815    $self->lock_collection($username, $collect);
816
817    $self->_set_live_metadata_array(@_);
818
819    # Release the lock once it is done
820    $self->unlock_collection($username, $collect);
821}
822
823
824sub dxml_metadata
825{
826    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
827    my $metaname = $parser->{'parameters'}->{'metaname'};
828    my $metamode = $parser->{'parameters'}->{'metamode'};
829   
830###!!!    print STDERR "**** Processing closing </Metadata> tag\n";
831   
832    my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
833   
834    # Find the right metadata tag and checks if we are going to
835    # override it
836    #
837    # Note: This over writes the first metadata block it
838    # encountered. If there are multiple Sections in the doc.xml, it
839    # might not behave as you would expect
840
841    my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
842##    print STDERR "**** checking $opt_doc_secnum <=> $curr_secnum\n" if (defined $opt_doc_secnum);
843##    print STDERR "**** metamode = $metamode\n";
844   
845    if ((!defined $opt_doc_secnum) || ($opt_doc_secnum eq $curr_secnum))
846    {
847        my $name_attr = $attrHash->{'name'};
848        # print STDOUT "*** testing: $name_attr eq $metaname ?   and  $metamode eq override ?\n";
849        if (($name_attr eq $metaname) && ($metamode eq "override"))
850        {
851            if (!defined $parser->{'parameters'}->{'poscount'})
852            {
853                $parser->{'parameters'}->{'poscount'} = 0;
854            }
855            else
856            {
857                $parser->{'parameters'}->{'poscount'}++;
858            }
859           
860            if (defined $parser->{'parameters'}->{'metapos'}) { # if pos defined, ignore any prevmeta if also defined, and just wait for pos match
861
862                if ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}) {
863                print STDERR "#### got pos match!!\n";
864                # Get the value and override the current value
865                my $metavalue = $parser->{'parameters'}->{'metavalue'};
866                $attrHash->{'_content'} = $metavalue;
867               
868                # Don't want it to wipe out any other pieces of metadata
869                $parser->{'parameters'}->{'metamode'} = "done";
870                }
871            }
872            elsif (defined $parser->{'parameters'}->{'prevmetavalue'}) { # if no pos defined but prevmeta defined, then wait for prevmeta match
873                if ($parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'}) {
874                print STDERR "### prev meta value matches\n";
875                my $metavalue = $parser->{'parameters'}->{'metavalue'};
876                $attrHash->{'_content'} = $metavalue;
877                $parser->{'parameters'}->{'metamode'} = "done";
878
879                }
880            }
881            elsif ($parser->{'parameters'}->{'poscount'} == 0) { # explicit catch all - ignored!!!!
882                # If no pos or prevmeta defined, then metavalue set for metaname becomes the ONLY instance of that metaname!!!
883                print STDERR "#### got pos match!!\n";
884                # Get the value and override the current value
885                my $metavalue = $parser->{'parameters'}->{'metavalue'};
886                $attrHash->{'_content'} = $metavalue;
887               
888                # Don't want it to wipe out any other pieces of metadata
889                $parser->{'parameters'}->{'metamode'} = "done";
890
891               
892            }
893
894           
895           
896        }
897    }
898
899    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
900    return [$tagname => $attrHash];
901}
902
903# This method exists purely for catching invalid section numbers that the client
904# requested to edit. Once the parser has reached the end (the final </Archive> tag),
905# we've seen all the Sections in the doc.xml, and none of their section nums matched
906# if the metamode has not been set to 'done' by then.
907sub dxml_archive
908{
909    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
910    my $metamode = $parser->{'parameters'}->{'metamode'};
911   
912    my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
913    my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'};
914   
915#    print STDERR "@@@ $tagname Processing a closing </Archive> tag [$curr_secnum|$opt_doc_secnum]\n";
916   
917    if ($metamode ne "done" && $curr_secnum ne $opt_doc_secnum) {
918    print STDERR "@@@ $tagname Finished processing FINAL Section.\n";
919
920    my $metaname = $parser->{'parameters'}->{'metaname'};
921    my $metavalue = $parser->{'parameters'}->{'metavalue'};
922   
923    print STDERR "@@@ Requested section number $opt_doc_secnum not found.\n";
924    print STDERR "\t(last seen section number in document was $curr_secnum)\n";
925    print STDERR "\tDiscarded metadata value '$metavalue' for meta '$metaname'\n";
926    print STDERR "\tin section $opt_doc_secnum.\n";
927    $parser->{'custom_err_msg'} = "Requested section number $opt_doc_secnum not found.";
928    }
929   
930    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
931    return [$tagname => $attrHash];
932}
933
934sub dxml_description
935{
936    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
937    my $metamode = $parser->{'parameters'}->{'metamode'};
938
939    my $curr_secnum = $parser->{'parameters'}->{'curr_section_num'};
940    my $opt_doc_secnum = $parser->{'parameters'}->{'secnum'} || "";
941   
942###!!!  print STDERR "**** Processing a closing </Description> tag \n";
943#   print STDERR "@@@ $tagname Processing a closing </Description> tag [$curr_secnum|$opt_doc_secnum]\n";
944   
945    # Accumulate the metadata
946
947    # We'll be accumulating metadata at this point if we haven't found and therefore
948    # haven't processed the metadata yet.
949    # For subsections, this means that if we're at a matching subsection, but haven't
950    # found the correct metaname to override in that subsection, we accumulate it as new
951    # meta in the subsection by adding it to the current description.
952    # If there's no subsection info for the metadata, it will accumulate at the top level
953    # section description if we hadn't found a matching metaname to override at this point.
954
955    # Both curr_secnum and opt_doc_secnum can be "". In the former case, it means we're now
956    # at the toplevel section. In the latter case, it means we want to process meta in the
957    # toplevel section. So the eq check between the values below will work in all cases.
958   
959    # The only time this won't work is if an opt_doc_secnum beyond the section numbers of
960    # this document has been provided. In that case, the metadata for that opt_doc_secnum
961    # won't get attached/accumulated to any part of the doc, not even its top-level section.
962
963    if ($curr_secnum eq $opt_doc_secnum
964        && ($metamode eq "accumulate" || $metamode eq "override")) {
965        if ($metamode eq "override") {
966        print "Got to end of <Description> block. No metadata value to override.  Switching 'metamode' to accumulate\n";
967        }
968
969        # If we get to here and metamode is override, this means there
970        # was no existing value to overide => treat as an append operation
971       
972        # Tack a new metadata tag on to the end of the <Metadata>+ block
973        my $metaname = $parser->{'parameters'}->{'metaname'};
974        my $metavalue = $parser->{'parameters'}->{'metavalue'};
975       
976        my $metadata_attr = {
977        '_content' => $metavalue,
978        'name' => $metaname,
979        'mode' => "accumulate"
980        };
981       
982        my $append_metadata = [ "Metadata" => $metadata_attr ];
983        my $description_content = $attrHash->{'_content'};
984       
985        print "Appending metadata to doc.xml\n";
986       
987        if (ref($description_content)) {
988        # got some existing interesting nested content
989        push(@$description_content, "    ", $append_metadata ,"\n        ");
990        }
991        else {
992        #description_content is most likely a string such as "\n"
993        $attrHash->{'_content'} = [$description_content, "    ", $append_metadata ,"\n" ];
994        }
995       
996        $parser->{'parameters'}->{'metamode'} = "done";
997    }       
998    else {
999        # metamode most likely "done" signifying that it has already found a position to add the metadata to.
1000##      print STDERR "**** NOT ACCUMULATE?!? \n";
1001    }
1002
1003    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1004    return [$tagname => $attrHash];
1005}
1006
1007sub edit_xml_file
1008{
1009    my $self = shift @_;
1010    my ($gsdl_cgi, $filename, $start_rules, $rules, $options) = @_;
1011
1012    # use XML::Rules to add it in (read in and out again)
1013    my $parser = XML::Rules->new(start_rules     => $start_rules,
1014                 rules           => $rules,
1015                 style           => 'filter',
1016                                 output_encoding => 'utf8' );
1017
1018    my $xml_in = "";
1019    if (!open(MIN,"<$filename")) {
1020    $gsdl_cgi->generate_error("Unable to read in $filename: $!");
1021    }
1022    else {
1023        # Read all the text in
1024    my $line;
1025    while (defined ($line=<MIN>)) {
1026        $xml_in .= $line;
1027    }
1028    close(MIN);
1029   
1030    my $MOUT;   
1031    if (!open($MOUT,">$filename")) {
1032        $gsdl_cgi->generate_error("Unable to write out to $filename: $!");
1033    }
1034    else {
1035        # Matched lines will get handled by the call backs
1036##      my $xml_out = "";
1037
1038        binmode($MOUT,":utf8");
1039        $parser->filter($xml_in,$MOUT, $options);
1040
1041#       binmode(MOUT,":utf8");
1042#       print MOUT $xml_out;
1043        close($MOUT);       
1044    }
1045    }
1046
1047    # copy across any custom error information that was stored during parsing
1048    $self->{'error_msg'} = $parser->{'custom_err_msg'} if(defined $parser->{'custom_err_msg'});   
1049}
1050
1051sub edit_doc_xml
1052{
1053    my $self = shift @_;
1054    my ($gsdl_cgi, $doc_xml_filename, $metaname, $metavalue, $metapos, $metamode, $opt_secnum, $prevmetavalue) = @_;
1055
1056    my $info_mess = <<RAWEND;
1057****************************
1058  edit_doc_xml()
1059****************************
1060RAWEND
1061
1062    $info_mess .= " doc_xml_filename = $doc_xml_filename\n" if defined($doc_xml_filename);
1063    $info_mess .= " metaname    = $metaname\n"    if defined($metaname);
1064    $info_mess .= " metapos     = $metapos\n"     if defined($metapos);
1065    $info_mess .= " metavalue   = $metavalue\n"   if defined($metavalue);
1066    $info_mess .= " metamode    = $metamode\n"    if defined($metamode);
1067    $info_mess .= " opt_secnum  = $opt_secnum\n"  if defined($opt_secnum);
1068    $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1069     
1070    $info_mess .= "****************************\n";
1071
1072    $gsdl_cgi->generate_message($info_mess);
1073   
1074    # To monitor which section/subsection number we are in
1075    my @start_rules =
1076    ( 'Section'    => \&dxml_start_section );
1077
1078    # use XML::Rules to add it in (read in and out again)
1079    # Set the call back functions
1080    my @rules =
1081    ( _default => 'raw',
1082      'Metadata'    => \&dxml_metadata,
1083      'Description' => \&dxml_description,
1084      'Archive'     => \&dxml_archive); # just for catching errors at end
1085     
1086    # Sets the parameters
1087    my $options = { 'metaname'  => $metaname,
1088            'metapos'   => $metapos,
1089            'metavalue' => $metavalue,
1090            'metamode'  => $metamode,
1091            'prevmetavalue' => $prevmetavalue };
1092           
1093    if (defined $opt_secnum) {
1094    $options->{'secnum'} = $opt_secnum;
1095    }
1096
1097    $self->edit_xml_file($gsdl_cgi,$doc_xml_filename,\@start_rules,\@rules,$options);
1098}
1099
1100sub set_archives_metadata_entry
1101{
1102    my $self = shift @_;
1103    my ($gsdl_cgi, $archive_dir, $collect_dir, $collect, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue) = @_;
1104
1105    my $info_mess = <<RAWEND;
1106****************************
1107  set_archives_metadata_entry()
1108****************************
1109RAWEND
1110
1111    $info_mess .= " archive_dir = $archive_dir\n" if defined($archive_dir);
1112    $info_mess .= " collect_dir = $collect_dir\n" if defined($collect_dir);
1113    $info_mess .= " collect     = $collect\n"     if defined($collect);
1114    $info_mess .= " infodbtype  = $infodbtype\n"  if defined($infodbtype);
1115    $info_mess .= " docid       = $docid\n"       if defined($docid);
1116    $info_mess .= " metaname    = $metaname\n"    if defined($metaname);
1117    $info_mess .= " metapos     = $metapos\n"     if defined($metapos);
1118    $info_mess .= " metavalue   = $metavalue\n"   if defined($metavalue);
1119    $info_mess .= " metamode    = $metamode\n"    if defined($metamode);
1120    $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1121     
1122    $info_mess .= "****************************\n";
1123
1124    $gsdl_cgi->generate_message($info_mess);
1125   
1126    # Obtain the doc.xml path for the specified docID
1127    my ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);
1128
1129    my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1130    my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid_root);
1131    my $doc_xml_file = $doc_rec->{'doc-file'}->[0];
1132   
1133    # The $doc_xml_file is relative to the archives, and now let's get the full path
1134    my $archives_dir = &util::filename_cat($collect_dir,$collect,"archives");   
1135    my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file);
1136
1137    # If we're overriding everything, then $metamode=override combined with $metapos=undefined and $prevmetavalue=undefined
1138    # in which case, we need to remove all metavalues for the metaname at the given (sub)section
1139    # Thereafter, we will finally be setting the overriding metavalue for this metaname
1140    if (!defined $prevmetavalue && !defined $metapos && $metamode eq "override") {
1141    # remove all values of $metaname metadata
1142    $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_xml_file), $metaname, undef, undef, $docid_secnum, $metamode);
1143    }
1144    # Edit the doc.xml file with the specified metadata name, value and position.
1145    # TODO: there is a potential problem here as this edit_doc_xml function
1146    # is assuming the simple doc.xml situation where there is only one Section and no SubSections.
1147    # Running import.pl -groupsize will cause this to have multiple sections in one doc.xml
1148   
1149    # dxml_metadata method ignores metapos if metamode anything other than override
1150    $self->edit_doc_xml($gsdl_cgi,$doc_xml_filename,
1151            $metaname,$metavalue,$metapos,$metamode,$docid_secnum,$prevmetavalue);
1152
1153    # return 0; # return 0 for now to indicate no error
1154    return (defined $self->{'error_msg'}) ? 1 : 0;
1155}
1156
1157
1158sub set_archives_metadata
1159{
1160    my $self = shift @_;
1161
1162    my $username  = $self->{'username'};
1163    my $collect   = $self->{'collect'};
1164    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1165   
1166    if ($baseaction::authentication_enabled) {
1167    # Ensure the user is allowed to edit this collection
1168    $self->authenticate_user($username, $collect);
1169    }
1170
1171    # Make sure the collection isn't locked by someone else
1172    $self->lock_collection($username, $collect);
1173
1174    $self->_set_archives_metadata(@_);
1175
1176    # Release the lock once it is done
1177    $self->unlock_collection($username, $collect);
1178}
1179
1180sub _set_archives_metadata_array
1181{
1182    my $self = shift @_;
1183   
1184    my $collect   = $self->{'collect'};
1185    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1186    my $site = $self->{'site'};
1187    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1188
1189    # look up additional args
1190   
1191    my $infodbtype = $self->{'infodbtype'};
1192   
1193    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1194   
1195    my $json_str      = $self->{'json'};
1196    my $doc_array = decode_json $json_str;
1197   
1198   
1199    my $global_status = 0;
1200    my $global_mess = "";
1201   
1202    my @all_docids = ();
1203   
1204    foreach my $doc_array_rec ( @$doc_array ) {
1205    my $status    = -1;
1206    my $docid     = $doc_array_rec->{'docid'};
1207
1208    push(@all_docids,$docid);
1209   
1210    my $metaname  = $doc_array_rec->{'metaname'};
1211    if(defined $metaname) {
1212       
1213        my $metapos   = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
1214
1215        my $metamode  = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1216        my $metavalue = $doc_array_rec->{'metavalue'};
1217        my $prevmetavalue = $self->{'prevmetavalue'}; # to make this sub behave as _set_archives_metadata
1218       
1219       
1220        if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1221        # make "accumulate" the default (less destructive, as it won't actually
1222        # delete any existing values)
1223        $metamode = "accumulate";
1224        }       
1225       
1226        $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect, $infodbtype,$docid,
1227                $metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1228    } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1229        my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1230       
1231        foreach my $metatable_rec ( @$metatable ) {
1232        $metaname  = $metatable_rec->{'metaname'};
1233        my $metamode  = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
1234        my $metapos = undef;
1235        my $prevmetavalue = undef;
1236        my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1237       
1238        foreach my $metavalue ( @$metavals ) {
1239            $status = $self->set_archives_metadata_entry($gsdl_cgi,$archive_dir, $collect_dir,$collect,$infodbtype,
1240                                 $docid,$metaname,$metapos,$metavalue,$metamode,$prevmetavalue);
1241           
1242            if($metamode eq "override") { # now, having overridden the metavalue for the first,
1243            # need to accumulate subsequent metavals for this metaname, else the just-assigned
1244            # metavalue for this metaname will be lost
1245            $metamode = "accumulate";
1246            }
1247        }           
1248        }       
1249    }
1250       
1251    if ($status != 0) {
1252        # Catch error if set infodb entry failed
1253        $global_status = $status;
1254        $global_mess .= "Failed to set metadata key: $docid\n";
1255        $global_mess .= "Exit status: $status\n";
1256        $global_mess .= "System Error Message: $!\n";
1257        $global_mess .= "-" x 20 . "\n";
1258    }
1259    }
1260   
1261    if ($global_status != 0) {
1262    $global_mess .= "PATH: $ENV{'PATH'}\n";
1263    $gsdl_cgi->generate_error($global_mess);
1264    }
1265    else {
1266    my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1267    $gsdl_cgi->generate_ok_message($mess);
1268    }
1269}
1270
1271sub set_archives_metadata_array
1272{
1273    my $self = shift @_;
1274
1275    my $username  = $self->{'username'};
1276    my $collect   = $self->{'collect'};
1277    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1278#    my $gsdlhome  = $self->{'gsdlhome'};
1279
1280    if ($baseaction::authentication_enabled) {
1281    # Ensure the user is allowed to edit this collection   
1282    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1283    }
1284
1285    my $site = $self->{'site'};
1286    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1287   
1288    $gsdl_cgi->checked_chdir($collect_dir);
1289
1290    # Obtain the collect dir
1291    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
1292
1293    # Make sure the collection isn't locked by someone else
1294    $self->lock_collection($username, $collect);
1295
1296    $self->_set_archives_metadata_array(@_);
1297   
1298    # Release the lock once it is done
1299    $self->unlock_collection($username, $collect);
1300}
1301
1302sub _remove_archives_metadata
1303{
1304    my $self = shift @_;
1305
1306    my $collect   = $self->{'collect'};
1307    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1308#   my $gsdlhome  = $self->{'gsdlhome'};
1309    my $infodbtype = $self->{'infodbtype'};
1310   
1311    my $site = $self->{'site'};
1312       
1313    # Obtain the collect and archive dir   
1314    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1315   
1316    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
1317
1318    # look up additional args
1319    my ($docid, $docid_secnum) = ($self->{'d'} =~ m/^(.*?)(\..*)?$/);
1320   
1321    my $metaname = $self->{'metaname'};
1322    my $metapos = $self->{'metapos'};
1323    my $metavalue = $self->{'metavalue'};
1324
1325    $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
1326    $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/)); # necessary to force fallback to undef here
1327
1328    # if the user hasn't told us what to delete, not having given a metavalue or metapos,
1329    # default to deleting the first metavalue for the given metaname
1330    # Beware that if both metapos AND metavalue are defined, both matches (if any)
1331    # seem to get deleted in one single remove_archives_meta action invocation.
1332    # Similarly, if 2 identical metavalues for a metaname exist and that metavalue is being
1333    # deleted, both get deleted.
1334    if(!defined $metapos && !defined $metavalue) {
1335        $metapos = 0;
1336    }
1337
1338    my $metamode = $self->{'metamode'};
1339    $metamode = undef if(defined $metamode && ($metamode =~ m/^\s*$/));
1340
1341    my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1342    my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1343
1344    # This now stores the full pathname
1345    my $doc_filename = $doc_rec->{'doc-file'}->[0];
1346
1347    my $status = $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, $metavalue, $docid_secnum, $metamode);
1348#   my $status = $self->remove_from_doc_xml($gsdl_cgi, &util::filename_cat($archive_dir, $doc_filename), $metaname, $metapos, undef, $docid_secnum);
1349   
1350    if ($status == 0)
1351    {
1352        my $mess = "\nremove-archives-metadata successful: \nKey[$docid]\n";
1353        $mess .= "  $metaname";
1354        $mess .= "->[$metapos]" if (defined $metapos);
1355        $mess .= " ($metavalue)" if (defined $metavalue);
1356        $gsdl_cgi->generate_ok_message($mess); 
1357    }
1358    else
1359    {
1360        my $mess .= "Failed to remove archives metadata key: $docid\n";
1361        $mess .= "Exit status: $status\n";
1362        $mess .= "System Error Message: $!\n";
1363        $mess .= "-" x 20 . "\n";
1364       
1365        $gsdl_cgi->generate_error($mess);
1366    }
1367   
1368    #return $status; # in case calling functions have a use for this
1369}
1370
1371sub remove_archives_metadata
1372{
1373    my $self = shift @_;
1374
1375    my $username  = $self->{'username'};
1376    my $collect   = $self->{'collect'};
1377    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1378   
1379    if ($baseaction::authentication_enabled)
1380    {
1381        # Ensure the user is allowed to edit this collection       
1382        $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1383    }
1384
1385    # Make sure the collection isn't locked by someone else
1386    $self->lock_collection($username, $collect);
1387
1388    $self->_remove_archives_metadata(@_);
1389
1390    # Release the lock once it is done
1391    $self->unlock_collection($username, $collect);
1392}
1393
1394sub remove_from_doc_xml
1395{
1396    my $self = shift @_;
1397    my ($gsdl_cgi, $doc_xml_filename, $metaname, $metapos, $metavalue, $secid, $metamode) = @_;
1398   
1399    my @start_rules = ('Section' => \&dxml_start_section);
1400   
1401    # Set the call-back functions for the metadata tags
1402    my @rules =
1403    (
1404        _default => 'raw',
1405        'Metadata' => \&rfdxml_metadata
1406    );
1407       
1408    my $parser = XML::Rules->new
1409    (
1410        start_rules => \@start_rules,
1411        rules => \@rules,
1412        style => 'filter',
1413        output_encoding => 'utf8',
1414#    normalisespaces => 1, # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1415        stripspaces => 2|0|0 # ineffectual
1416    );
1417   
1418    my $status = 0;
1419    my $xml_in = "";
1420    if (!open(MIN,"<$doc_xml_filename"))
1421    {
1422        $gsdl_cgi->generate_error("Unable to read in $doc_xml_filename: $!");
1423        $status = 1;
1424    }
1425    else
1426    {
1427        # Read them in
1428        my $line;
1429        while (defined ($line=<MIN>)) {
1430            $xml_in .= $line;
1431        }
1432        close(MIN);
1433
1434        # Filter with the call-back functions
1435        my $xml_out = "";
1436
1437        my $MOUT;
1438        if (!open($MOUT,">$doc_xml_filename")) {
1439            $gsdl_cgi->generate_error("Unable to write out to $doc_xml_filename: $!");
1440            $status = 1;
1441        }
1442        else {
1443            binmode($MOUT,":utf8");
1444            $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, secid => $secid, metamode => $metamode});
1445            close($MOUT);       
1446        }
1447    }
1448    return $status;
1449}
1450
1451sub rfdxml_metadata
1452{
1453    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1454
1455    # For comparisons, toplevel section is indicated by ""
1456    my $curr_sec_num = $parser->{'parameters'}->{'curr_section_num'} || "";
1457    my $secid = $parser->{'parameters'}->{'secid'} || "";
1458
1459    if (!($secid eq $curr_sec_num))
1460    {
1461        # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1462        return [$tagname => $attrHash];
1463    }
1464
1465    if ($parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
1466    {
1467        if (!defined $parser->{'parameters'}->{'poscount'})
1468        {
1469            $parser->{'parameters'}->{'poscount'} = 0;
1470        }
1471        else
1472        {
1473            $parser->{'parameters'}->{'poscount'}++;
1474        }
1475       
1476        # if overriding (for set-meta) but no metapos, then clear all the meta for this metaname
1477        if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'}) &&(!defined $parser->{'parameters'}->{'metavalue'})) {         
1478            return [];
1479        }
1480
1481        if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
1482        {   
1483            return [];
1484        }
1485       
1486        if ((defined $parser->{'parameters'}->{'metavalue'}) && ($parser->{'parameters'}->{'metavalue'} eq $attrHash->{'_content'}))
1487        {   
1488            return [];
1489        }
1490    }
1491   
1492    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1493    return [$tagname => $attrHash];
1494}
1495
1496sub mxml_metadata
1497{
1498    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1499    my $metaname = $parser->{'parameters'}->{'metaname'};
1500    my $metamode = $parser->{'parameters'}->{'metamode'};
1501
1502    # Report error if we don't see FileName tag before this
1503    die "Fatal Error: Unexpected metadata.xml structure. Undefined current_file, possibly encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1504   
1505    # Don't do anything if we are not in the right FileSet
1506    my $file_regexp = $parser->{'parameters'}->{'current_file'};
1507    if ($file_regexp =~ /\.\*/) {
1508    # Only interested in a file_regexp if it specifies precisely one
1509    # file. 
1510    # So, skip anything with a .* in it as it is too general
1511##  print STDERR "@@@@ Skipping entry in metadata.xml where FileName=.* as it is too general\n";
1512    return [$tagname => $attrHash];
1513    }
1514    my $src_file = $parser->{'parameters'}->{'src_file'};
1515    if (!($src_file =~ /$file_regexp/)) {
1516    return [$tagname => $attrHash];
1517    }
1518##    print STDERR "*** mxl metamode = $metamode\n";
1519
1520    # Find the right metadata tag and checks if we are going to override it
1521    my $name_attr = $attrHash->{'name'};
1522    if (($name_attr eq $metaname) && ($metamode eq "override")) {
1523
1524    # now metadata.xml functions need to keep track of metapos
1525    if (!defined $parser->{'parameters'}->{'poscount'})
1526    {
1527        $parser->{'parameters'}->{'poscount'} = 0;
1528    }
1529    else
1530    {
1531        $parser->{'parameters'}->{'poscount'}++;
1532    }
1533
1534    # If either the metapos or prevmetavalue is set,
1535        # get the value and override the current value
1536    my $metavalue = $parser->{'parameters'}->{'metavalue'};
1537
1538    if(defined $parser->{'parameters'}->{'prevmetavalue'} && $parser->{'parameters'}->{'prevmetavalue'} eq $attrHash->{'_content'})
1539    {
1540        $attrHash->{'_content'} = $metavalue;
1541
1542        ##  print STDERR "**** overriding metadata.xml\n";
1543       
1544        # Don't want it to wipe out any other pieces of metadata
1545        $parser->{'parameters'}->{'metamode'} = "done";
1546    }
1547    elsif(defined $parser->{'parameters'}->{'metapos'} && $parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'})
1548    {
1549        $attrHash->{'_content'} = $metavalue;
1550        $parser->{'parameters'}->{'metamode'} = "done";
1551    }
1552    }
1553
1554    # mxml_description will process the metadata if metadata is accumulate,
1555    # or if we haven't found the metadata to override
1556
1557    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1558    return [$tagname => $attrHash];
1559}
1560
1561
1562sub mxml_description
1563{
1564    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1565    my $metamode = $parser->{'parameters'}->{'metamode'};   
1566
1567    # Failed... Report error if we don't see FileName tag before this
1568    die "Fatal Error: Unexpected metadata.xml structure. Undefind current_file, possiblely encountered Description before FileName" if (!defined($parser->{'parameters'}->{'current_file'}));
1569
1570    # Don't do anything if we are not in the right FileSet
1571    my $file_regexp = $parser->{'parameters'}->{'current_file'};
1572    if ($file_regexp =~ m/\.\*/) {
1573    # Only interested in a file_regexp if it specifies precisely one
1574    # file. 
1575    # So, skip anything with a .* in it as it is too general
1576    return [$tagname => $attrHash];
1577    }
1578    my $src_file = $parser->{'parameters'}->{'src_file'};
1579   
1580    if (!($src_file =~ m/$file_regexp/)) {
1581    return [$tagname => $attrHash];
1582    }
1583
1584    # Accumulate the metadata block to the end of the description block
1585    # Note: This adds metadata block to all description blocks, so if there are
1586    # multiple FileSets, it will add to all of them
1587    if (($metamode eq "accumulate") || ($metamode eq "override")) {
1588
1589    # if metamode was "override" but get to here then it failed to
1590    # find an item to override, in which case it should append its
1591    # value to the end, just like the "accumulate" mode
1592
1593    if ($metamode eq "override") {
1594        print "No metadata value to override.  Switching 'metamode' to accumulate\n";
1595    }
1596
1597    # tack a new metadata tag on to the end of the <Metadata>+ block
1598    my $metaname = $parser->{'parameters'}->{'metaname'};
1599    my $metavalue = $parser->{'parameters'}->{'metavalue'};
1600   
1601    my $metadata_attr = { '_content' => $metavalue,
1602                  'name'     => $metaname,
1603                  'mode'     => "accumulate" };
1604
1605    my $append_metadata = [ "Metadata" => $metadata_attr ];
1606    my $description_content = $attrHash->{'_content'};
1607   
1608##  print STDERR "*** appending to metadata.xml\n";
1609
1610    # append the new metadata element to the end of the current
1611    # content contained inside this tag
1612    if (ref($description_content) eq "") {
1613        # => string or numeric literal
1614        # this is caused by a <Description> block has no <Metadata> child elements
1615        # => set up an empty array in '_content'
1616        $attrHash->{'_content'} = [ "\n" ];
1617        $description_content = $attrHash->{'_content'};
1618    }
1619
1620    push(@$description_content,"    ", $append_metadata ,"\n        ");
1621    $parser->{'parameters'}->{'metamode'} = "done";
1622    }
1623
1624    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1625    return [$tagname => $attrHash];
1626}
1627
1628
1629sub mxml_fileset
1630{
1631    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1632
1633    # Initilise the current_file
1634    # Note: According to http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd
1635    # FileName tag must come before Description tag
1636    $parser->{'parameters'}->{'current_file'} = "";
1637
1638    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1639    return [$tagname => $attrHash];
1640}
1641
1642sub mxml_directorymetadata
1643{
1644    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
1645
1646    # if we haven't processed the metadata when we reach the end of metadata.xml
1647    # it's because there's no particular FileSet element whose FileName matched
1648    # In which case, add a new FileSet for this FileName
1649    my $metamode = $parser->{'parameters'}->{'metamode'};
1650    if($metamode ne "done") {
1651   
1652    if ($metamode eq "override") {
1653        print "No metadata value to override.  Switching 'metamode' to accumulate\n";
1654    }
1655
1656    # If we get to here and metamode is override, this means there
1657    # was no existing value to overide => treat as an append operation
1658   
1659    # Create a new FileSet element and append to DirectoryMetadata
1660    # <FileSet>
1661    # <FileName>src_file</FileName>
1662    # <Description>
1663    # <Metadata mode="" name="">metavalue</Metadata>
1664    # </Description>
1665    # </FileSet>
1666    my $src_file = $parser->{'parameters'}->{'src_file'};
1667    my $metaname = $parser->{'parameters'}->{'metaname'};
1668    my $metavalue = $parser->{'parameters'}->{'metavalue'};
1669    my $metadata_attr = {
1670        '_content' => $metavalue,
1671        'name' => $metaname,
1672        'mode' => "accumulate"
1673    };
1674    my $append_metadata = [ "Metadata" => $metadata_attr ];
1675    my $description_attr = { '_content' => [ "\n\t\t   ", $append_metadata, "\n\t\t"] };
1676    my $description_element = [ "Description" => $description_attr ];
1677
1678    #_content is not an attribute, it's special and holds the children of this element
1679    # including the textnode value embedded in this element if any.
1680    my $filename_attr = {'_content' => $src_file};
1681    my $filename_element = [ "FileName" => $filename_attr ];
1682
1683    my $fileset_attr = {};
1684    $fileset_attr->{'_content'} = [ "\n\t\t", $filename_element,"\n\t\t",$description_element ,"\n\t" ];
1685    my $fileset = [ "FileSet" => $fileset_attr ]; #my $fileset = [ "FileSet" => {} ];
1686   
1687   
1688    # get children of dirmeta, and push the new FileSet element onto it
1689    print "Appending metadata to metadata.xml\n";
1690    my $dirmeta_content = $attrHash->{'_content'};
1691    if (ref($dirmeta_content)) {
1692        # got some existing interesting nested content
1693        #push(@$dirmeta_content, "    ", $fileset ,"\n        ");
1694        push(@$dirmeta_content, "\t", $fileset ,"\n");
1695    }
1696    else {
1697        #description_content is most likely a string such as "\n"
1698        #$attrHash->{'_content'} = [$dirmeta_content, "    ", $fileset ,"\n" ];
1699        $attrHash->{'_content'} = [$dirmeta_content, "\t", $fileset ,"\n" ];
1700    }   
1701
1702    $parser->{'parameters'}->{'metamode'} = "done";
1703    }
1704    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
1705    return [$tagname => $attrHash];
1706}
1707
1708
1709sub edit_metadata_xml
1710{
1711    my $self = shift @_;
1712    my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $metamode, $src_file, $prevmetavalue) = @_;
1713
1714    # Set the call-back functions for the metadata tags
1715    my @rules =
1716    ( _default => 'raw',
1717          'FileName' => \&mxml_filename,
1718      'Metadata' => \&mxml_metadata,
1719      'Description' => \&mxml_description,
1720          'FileSet' => \&mxml_fileset,
1721      'DirectoryMetadata' => \&mxml_directorymetadata);
1722
1723    # use XML::Rules to add it in (read in and out again)
1724    my $parser = XML::Rules->new(rules => \@rules,
1725                 style => 'filter',
1726                                 output_encoding => 'utf8',
1727                 stripspaces => 2|0|0); # http://search.cpan.org/~jenda/XML-Rules-1.16/lib/XML/Rules.pm
1728
1729    if (!-e $metadata_xml_filename) {
1730   
1731        if (open(MOUT,">$metadata_xml_filename")) {
1732           
1733            my $src_file_re = &util::filename_to_regex($src_file);
1734            # shouldn't the following also be in the above utility routine??
1735            # $src_file_re =~ s/\./\\./g;
1736       
1737            print MOUT "<?xml version=\"1.0\"?>\n";
1738            print MOUT "<DirectoryMetadata>\n";
1739            print MOUT " <FileSet>\n";
1740            print MOUT "  <FileName>$src_file_re</FileName>\n";
1741            print MOUT "  <Description>\n";
1742            print MOUT "  </Description>\n";
1743            print MOUT " </FileSet>\n";
1744            print MOUT "</DirectoryMetadata>\n";
1745
1746            close(MOUT);
1747        }
1748        else {
1749            $gsdl_cgi->generate_error("Unable to create $metadata_xml_filename: $!");
1750        }
1751    }
1752   
1753   
1754    my $xml_in = "";
1755    if (!open(MIN,"<$metadata_xml_filename")) {
1756        $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
1757    }
1758    else {
1759        # Read them in
1760        my $line;
1761        while (defined ($line=<MIN>)) {
1762            $xml_in .= $line;
1763        }
1764        close(MIN);
1765
1766        # Filter with the call-back functions
1767        my $xml_out = "";
1768
1769        my $MOUT;
1770        if (!open($MOUT,">$metadata_xml_filename")) {
1771            $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
1772        }
1773        else {
1774            binmode($MOUT,":utf8");
1775
1776            # Some wise person please find out how to keep the DTD and encode lines in after it gets filtered by this XML::Rules
1777            # At the moment, I will just hack it!
1778            #my $header_with_utf8_dtd = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
1779            #$header_with_utf8_dtd .= "<!DOCTYPE DirectoryMetadata SYSTEM \"http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd\">";
1780            #$xml_out =~ s/\<\?xml\sversion\=\"1.0\"\?\>/$header_with_utf8_dtd/;
1781            #print MOUT $xml_out;
1782
1783            $parser->filter($xml_in, $MOUT, { metaname => $metaname,
1784                              metapos => $metapos,
1785                      metavalue => $metavalue,
1786                      metamode => $metamode,
1787                      src_file => $src_file,
1788                      prevmetavalue => $prevmetavalue,
1789                      current_file => undef} );
1790            close($MOUT);       
1791        }
1792   }
1793}
1794
1795
1796sub set_import_metadata
1797{
1798    my $self = shift @_;
1799   
1800    my $username  = $self->{'username'};
1801    my $collect   = $self->{'collect'};
1802    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1803   
1804    if ($baseaction::authentication_enabled) {
1805    # Ensure the user is allowed to edit this collection
1806    $self->authenticate_user($username, $collect);
1807    }
1808
1809    # Make sure the collection isn't locked by someone else
1810    $self->lock_collection($username, $collect);
1811 
1812    $self->_set_import_metadata(@_);
1813
1814    # Release the lock once it is done
1815    $self->unlock_collection($username, $collect);
1816   
1817}
1818
1819sub set_import_metadata_array
1820{
1821    my $self = shift @_;
1822
1823    my $username  = $self->{'username'};
1824    my $collect   = $self->{'collect'};
1825    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1826#    my $gsdlhome  = $self->{'gsdlhome'};
1827
1828    if ($baseaction::authentication_enabled) {
1829    # Ensure the user is allowed to edit this collection   
1830    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
1831    }
1832
1833    my $site = $self->{'site'};
1834    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1835   
1836    $gsdl_cgi->checked_chdir($collect_dir);
1837
1838    # Make sure the collection isn't locked by someone else
1839    $self->lock_collection($username, $collect);
1840
1841    $self->_set_import_metadata_array(@_);
1842
1843    # Release the lock once it is done
1844    $self->unlock_collection($username, $collect);
1845
1846}
1847
1848
1849sub _set_import_metadata_array
1850{
1851    my $self = shift @_;
1852
1853    my $collect   = $self->{'collect'};
1854    my $gsdl_cgi  = $self->{'gsdl_cgi'};
1855
1856    my $site = $self->{'site'};
1857    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
1858   
1859    # look up additional args
1860   
1861    my $infodbtype = $self->{'infodbtype'};
1862   
1863    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");   
1864    my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1865   
1866    my $json_str = $self->{'json'};
1867    my $doc_array = decode_json $json_str;
1868   
1869    my $global_status = 0;
1870    my $global_mess = "";
1871   
1872    my @all_docids = ();
1873   
1874    foreach my $doc_array_rec ( @$doc_array )
1875    {
1876    my $status = -1;
1877    my $docid = $doc_array_rec->{'docid'};
1878   
1879    my ($docid_root,$docid_secnum);
1880    if(defined $docid) {   
1881        ($docid_root,$docid_secnum) = ($docid =~ m/^(.*?)(\..*)?$/);   
1882        # as yet no support for setting subsection metadata in metadata.xml
1883        if ((defined $docid_secnum) && ($docid_secnum !~ m/^\s*$/)) {
1884        $gsdl_cgi->generate_message("*** docid: $docid. No support yet for setting import metadata at subsections level.\n");
1885        next; # skip this docid in for loop
1886        }
1887    }
1888
1889    push(@all_docids,$docid); # docid_root rather
1890   
1891    my $metaname = $doc_array_rec->{'metaname'};
1892    if (defined $metaname) {
1893        my $metamode = $doc_array_rec->{'metamode'} || $self->{'metamode'};
1894        my $metavalue = $doc_array_rec->{'metavalue'};
1895        $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
1896
1897        if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1898        # make "accumulate" the default (less destructive, as it won't actually
1899        # delete any existing values)
1900        $metamode = "accumulate";
1901        }
1902
1903        # adding metapos and prevmetavalue support to import_metadata subroutines
1904        my $metapos   = $doc_array_rec->{'metapos'}; # don't force undef to 0. Undef has meaning when metamode=override
1905        my $prevmetavalue = $self->{'prevmetavalue'};
1906
1907        $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
1908       
1909    } elsif (defined $doc_array_rec->{'metatable'}) { # if no metaname, we expect a metatable
1910        my $metatable = $doc_array_rec->{'metatable'}; # a subarray, or need to generate an error saying JSON structure is wrong
1911       
1912        foreach my $metatable_rec ( @$metatable ) {
1913        $metaname  = $metatable_rec->{'metaname'};
1914        my $metamode  = $metatable_rec->{'metamode'} || $doc_array_rec->{'metamode'} || $self->{'metamode'};
1915        if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
1916            # make "accumulate" the default (less destructive, as it won't actually
1917            # delete any existing values)
1918            $metamode = "accumulate";
1919        }
1920
1921        # No support for metapos and prevmetavalue in the JSON metatable substructure
1922        my $metapos = undef;
1923        my $prevmetavalue = undef;
1924        my $metavals = $metatable_rec->{'metavals'}; # a sub-subarray
1925       
1926        foreach my $metavalue ( @$metavals ) {
1927            $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
1928
1929            $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
1930            if($metamode eq "override") { # now, having overridden the first metavalue of the metaname,
1931            # need to accumulate subsequent metavals for this metaname, else the just-assigned
1932            # metavalue for this metaname will be lost
1933            $metamode = "accumulate";
1934            }
1935        }
1936        }
1937    }       
1938    }
1939
1940    # always a success message
1941    my $mess = "set-archives-metadata-array successful: Keys[ ".join(", ",@all_docids)."]\n";
1942    $gsdl_cgi->generate_ok_message($mess);
1943}
1944
1945# always returns true (1)
1946sub set_import_metadata_entry
1947{
1948    my $self = shift @_;
1949    my ($gsdl_cgi, $arcinfo_doc_filename, $infodbtype, $docid, $metaname, $metapos, $metavalue, $metamode, $prevmetavalue, $collect, $collect_dir) = @_;
1950
1951    my $info_mess = <<RAWEND;
1952****************************
1953  set_import_metadata_entry()
1954****************************
1955RAWEND
1956
1957    $info_mess .= " collect_dir = $collect_dir\n" if defined($collect_dir);
1958    $info_mess .= " collect     = $collect\n"     if defined($collect);
1959    $info_mess .= " infodbtype  = $infodbtype\n"  if defined($infodbtype);
1960    $info_mess .= " arcinfo_doc_filename  = $arcinfo_doc_filename\n"  if defined($arcinfo_doc_filename);
1961    $info_mess .= " docid       = $docid\n"       if defined($docid);
1962    $info_mess .= " metaname    = $metaname\n"    if defined($metaname);
1963    $info_mess .= " metapos     = $metapos\n"     if defined($metapos);
1964    $info_mess .= " metavalue   = $metavalue\n"   if defined($metavalue);
1965    $info_mess .= " metamode    = $metamode\n"    if defined($metamode);
1966    $info_mess .= " prevmetaval = $prevmetavalue\n" if defined($prevmetavalue);
1967     
1968    $info_mess .= "****************************\n";
1969
1970    $gsdl_cgi->generate_message($info_mess);
1971
1972    # import works with metadata.xml which can have inherited metadata
1973    # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
1974    # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
1975    # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
1976    # what they're doing if they provide a metapos.
1977    if(defined $metapos) {
1978    print STDERR "@@@@ WARNING: metapos defined.\n";
1979    print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
1980    }
1981
1982    # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
1983    # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
1984    my $metadata_xml_file;
1985    my $import_filename = undef;
1986   
1987    if (defined $docid) {
1988    # my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
1989    my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
1990
1991    # This now stores the full pathname
1992    $import_filename = $doc_rec->{'src-file'}->[0];
1993    $import_filename = &util::placeholders_to_abspath($import_filename);
1994
1995    } else { # only for set_import_meta, not the case when calling method is set_import_metadata_array
1996         # as the array version of the method doesn't support the -f parameter yet
1997    my $import_file  = $self->{'f'};
1998    $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
1999    }
2000   
2001    # figure out correct metadata.xml file [?]
2002    # Assuming the metadata.xml file is next to the source file
2003    # Note: This will not work if it is using the inherited metadata from the parent folder
2004    my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2005    my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2006   
2007    # If we're overriding everything, then $prevmetavalue=undefined and
2008    # $metamode=override combined with $metapos=undefined
2009    # in which case we need to remove all metavalues for the metaname at the given (sub)section
2010    # Thereafter, we will finally be able to set the overriding metavalue for this metaname
2011    if(!defined $prevmetavalue && !defined $metapos && $metamode eq "override") {
2012##  print STDERR "@@@ REMOVING all import metadata for $metaname\n";
2013    $self->remove_from_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, undef, $import_tailname, $metamode); # we're removing all values, so metavalue=undef
2014
2015    }
2016
2017    # Edit the metadata.xml
2018    # Modified by Jeffrey from DL Consulting
2019    # Handle the case where there is one metadata.xml file for multiple FileSets
2020    # The XML filter needs to know whether it is in the right FileSet
2021    # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2022    # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2023    $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2024                 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2025    #return 0;
2026    return $metadata_xml_filename;
2027}
2028
2029sub _remove_import_metadata
2030{
2031    my $self = shift @_;
2032
2033    my $collect   = $self->{'collect'};
2034    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2035#   my $gsdlhome  = $self->{'gsdlhome'};
2036    my $infodbtype = $self->{'infodbtype'};
2037   
2038    # Obtain the collect dir
2039    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2040    my $site = $self->{'site'};
2041    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2042   
2043    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2044    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2045
2046    # look up additional args
2047    my $docid = $self->{'d'};
2048    if ((!defined $docid) || ($docid =~ m/^\s*$/))
2049    {
2050        $gsdl_cgi->generate_error("No docid (d=...) specified.\n");
2051    }
2052   
2053    my $metaname = $self->{'metaname'};
2054    my $metapos = $self->{'metapos'};
2055    my $metavalue = $self->{'metavalue'};
2056
2057    $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
2058    $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/));
2059
2060    if(defined $metavalue) { # metavalue is now a compulsory arg for remove_import_metadata()
2061        $metavalue =~ s/&lt;(.*?)&gt;/<$1>/g;
2062    } elsif (!defined $metapos) { # if given no metavalue or metapos to delete, default to deleting the 1st
2063        $metapos = 0;
2064    }
2065    my $metamode = $self->{'metamode'};
2066    $metamode = undef if(defined $metamode && ($metamode =~ m/^\s*$/));
2067
2068    # import works with metadata.xml which can have inherited metadata
2069    # so setting or removing at a metapos can have unintended effects for a COMPLEX collection
2070    # (a collection that has or can have inherited metadata). Metapos has expected behaviour for
2071    # a SIMPLE collection, which is one that doesn't have inherited metadata. Assume caller knows
2072    # what they're doing if they provide a metapos.
2073    if(defined $metapos) {
2074        print STDERR "@@@@ WARNING: metapos defined.\n";
2075        print STDERR "@@@@ Assuming SIMPLE collection and proceeding to modify the import meta at $metapos.\n";
2076    }
2077   
2078    # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2079    # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2080    my $metadata_xml_file;
2081    my $import_filename = undef;
2082    if (defined $docid)
2083    {
2084        my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2085        my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2086
2087        # This now stores the full pathname
2088        $import_filename = $doc_rec->{'src-file'}->[0];
2089        $import_filename = &util::placeholders_to_abspath($import_filename);
2090    }
2091
2092    if((!defined $import_filename) || ($import_filename =~ m/^\s*$/))
2093    {
2094        $gsdl_cgi->generate_error("There is no metadata\n");
2095    }
2096   
2097    # figure out correct metadata.xml file [?]
2098    # Assuming the metadata.xml file is next to the source file
2099    # Note: This will not work if it is using the inherited metadata from the parent folder
2100    my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename);
2101    my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2102   
2103    $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
2104   
2105    my $mess = "remove-import-metadata successful: Key[$docid] -> $metadata_xml_filename\n";
2106    $mess .= "  $metaname";
2107    $mess .= " = $metavalue\n";
2108   
2109    $gsdl_cgi->generate_ok_message($mess);
2110
2111    #return $status; # in case calling functions have a use for this
2112}
2113
2114sub remove_import_metadata
2115{
2116    my $self = shift @_;
2117   
2118    my $username = $self->{'username'};
2119    my $collect   = $self->{'collect'};
2120    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2121   
2122    if ($baseaction::authentication_enabled) {
2123        # Ensure the user is allowed to edit this collection       
2124        $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2125    }
2126
2127    # Make sure the collection isn't locked by someone else
2128    $self->lock_collection($username, $collect);
2129   
2130    $self->_remove_import_metadata(@_);
2131
2132    # Release the lock once it is done
2133    $self->unlock_collection($username, $collect);
2134
2135}
2136
2137sub remove_from_metadata_xml
2138{
2139    my $self = shift @_;
2140    my ($gsdl_cgi, $metadata_xml_filename, $metaname, $metapos, $metavalue, $src_file, $metamode) = @_;
2141    # metamode generally has no meaning for removing meta, but is used by set_meta
2142    # when overriding all metavals for a metaname, in which case remove_meta is called with metamode
2143
2144    # Set the call-back functions for the metadata tags
2145    my @rules =
2146    (
2147        _default => 'raw',
2148        'Metadata' => \&rfmxml_metadata,
2149        'FileName' => \&mxml_filename
2150    );
2151       
2152    my $parser = XML::Rules->new
2153    (
2154        rules => \@rules,
2155        style => 'filter',
2156        output_encoding => 'utf8',
2157     #normalisespaces => 1,
2158            stripspaces => 2|0|0 # ineffectual
2159    );
2160   
2161    my $xml_in = "";
2162    if (!open(MIN,"<$metadata_xml_filename"))
2163    {
2164        $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
2165    }
2166    else
2167    {
2168        # Read them in
2169        my $line;
2170        while (defined ($line=<MIN>)) {
2171            $xml_in .= $line;
2172        }
2173        close(MIN);
2174
2175        # Filter with the call-back functions
2176        my $xml_out = "";
2177
2178        my $MOUT;
2179        if (!open($MOUT,">$metadata_xml_filename")) {
2180            $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
2181        }
2182        else {
2183            binmode($MOUT,":utf8");
2184            $parser->filter($xml_in, $MOUT, {metaname => $metaname, metapos => $metapos, metavalue => $metavalue, src_file => $src_file, metamode => $metamode, current_file => undef});
2185            close($MOUT);       
2186        }
2187    }
2188}
2189
2190sub rfmxml_metadata
2191{
2192    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
2193
2194    # metadata.xml does not handle subsections
2195
2196    # since metadata.xml now has to deal with metapos, we keep track of the metadata position
2197    if (($parser->{'parameters'}->{'src_file'} eq $parser->{'parameters'}->{'current_file'})
2198        && $parser->{'parameters'}->{'metaname'} eq $attrHash->{'name'})
2199    {
2200        if (!defined $parser->{'parameters'}->{'poscount'})
2201        {
2202            $parser->{'parameters'}->{'poscount'} = 0;
2203        }
2204        else
2205        {
2206            $parser->{'parameters'}->{'poscount'}++;
2207        }
2208
2209        # if overriding but no metapos, then clear all the meta for this metaname
2210        if ((defined $parser->{'parameters'}->{'metamode'}) && ($parser->{'parameters'}->{'metamode'} eq "override") && (!defined $parser->{'parameters'}->{'metapos'}) && (!defined $parser->{'parameters'}->{'metavalue'})) {
2211            return [];
2212        }
2213   
2214        if ((defined $parser->{'parameters'}->{'metapos'}) && ($parser->{'parameters'}->{'poscount'} == $parser->{'parameters'}->{'metapos'}))
2215        {
2216            return [];
2217        }
2218        if ((defined $parser->{'parameters'}->{'metavalue'}) && ($attrHash->{'_content'} eq $parser->{'parameters'}->{'metavalue'}))
2219        {
2220            return [];
2221        }       
2222    }
2223
2224    # RAW is [$tagname => $attrHash] not $tagname => $attrHash!!
2225    return [$tagname => $attrHash];
2226}
2227
2228sub _remove_live_metadata
2229{
2230    my $self = shift @_;
2231
2232    my $collect   = $self->{'collect'};
2233    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2234#    my $gsdlhome  = $self->{'gsdlhome'};
2235    my $infodbtype = $self->{'infodbtype'};
2236
2237    # Obtain the collect dir
2238    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2239    my $site = $self->{'site'};
2240    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2241
2242   
2243    # look up additional args
2244    my $docid     = $self->{'d'};
2245    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2246      $gsdl_cgi->generate_error("No docid (d=...) specified.");
2247    }
2248   
2249    # Generate the dbkey
2250    my $metaname  = $self->{'metaname'};
2251    my $dbkey = "$docid.$metaname";
2252
2253    # To people who know $collect_tail please add some comments
2254    # Obtain the live gdbm_db path
2255    my $collect_tail = $collect;
2256    $collect_tail =~ s/^.*[\/|\\]//;
2257    my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2258    my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, "live-$collect_tail", $index_text_directory);
2259
2260    # Remove the key
2261    my $cmd = "gdbmdel \"$infodb_file_path\" \"$dbkey\"";
2262    my $status = system($cmd);
2263    if ($status != 0) {
2264        # Catch error if gdbmdel failed
2265    my $mess = "Failed to set metadata key: $dbkey\n";
2266   
2267    $mess .= "PATH: $ENV{'PATH'}\n";
2268    $mess .= "cmd = $cmd\n";
2269    $mess .= "Exit status: $status\n";
2270    $mess .= "System Error Message: $!\n";
2271
2272    $gsdl_cgi->generate_error($mess);
2273    }
2274    else {
2275    $gsdl_cgi->generate_ok_message("DB remove successful: Key[$metaname]");
2276    }
2277
2278}
2279
2280sub remove_live_metadata
2281{
2282    my $self = shift @_;
2283
2284    my $username  = $self->{'username'};
2285    my $collect   = $self->{'collect'};
2286    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2287    my $gsdlhome  = $self->{'gsdlhome'};
2288   
2289    if ($baseaction::authentication_enabled) {
2290    # Ensure the user is allowed to edit this collection   
2291    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2292    }
2293
2294    # Make sure the collection isn't locked by someone else
2295    $self->lock_collection($username, $collect);
2296
2297    $self->_remove_live_metadata(@_);
2298
2299    $self->unlock_collection($username, $collect);
2300}
2301
2302sub remove_metadata
2303{
2304    my $self = shift @_;
2305
2306    my $where = $self->{'where'};
2307    if(!$where || ($where =~ m/^\s*$/)) {
2308    $self->remove_index_metadata(@_); # call the full version of set_index_meta for the default behaviour
2309    return;
2310    }
2311
2312    my $username  = $self->{'username'};
2313    my $collect   = $self->{'collect'};
2314    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2315
2316    if ($baseaction::authentication_enabled) {
2317    # Ensure the user is allowed to edit this collection   
2318    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2319    }
2320
2321    # Make sure the collection isn't locked by someone else
2322    $self->lock_collection($username, $collect);
2323
2324    # check which directories need to be processed, specified in $where as
2325    # any combination of import|archives|index|live
2326    if($where =~ m/import/) {
2327    $self->_remove_import_metadata(@_);     
2328    }
2329    if($where =~ m/archives/) {
2330    $self->_remove_archives_metadata(@_);       
2331   }
2332    if($where =~ m/index/) {
2333    $self->_remove_index_metadata(@_);     
2334    }
2335
2336    # Release the lock once it is done
2337    $self->unlock_collection($username, $collect);
2338}
2339
2340# the internal version, without authentication
2341sub _remove_index_metadata
2342{   
2343    my $self = shift @_;
2344
2345    my $collect   = $self->{'collect'};
2346    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2347#    my $gsdlhome  = $self->{'gsdlhome'};
2348    my $infodbtype = $self->{'infodbtype'};
2349   
2350    # Obtain the collect dir
2351    my $site = $self->{'site'};
2352    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2353    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2354
2355        # look up additional args
2356    my $docid     = $self->{'d'};
2357    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
2358      $gsdl_cgi->generate_error("No docid (d=...) specified.");
2359    }
2360    my $metaname  = $self->{'metaname'};
2361    my $metapos   = $self->{'metapos'};
2362    my $metavalue = $self->{'metavalue'};
2363
2364    $metapos = undef if(defined $metapos && ($metapos =~ m/^\s*$/));
2365    $metavalue = undef if(defined $metavalue && ($metavalue =~ m/^\s*$/)); # necessary to force fallback to undef here
2366
2367    # To people who know $collect_tail please add some comments
2368    # -> In collection groups, I think collect_tailname is the subcollection name,
2369    # e.g. colgroup-name/col-tail-name
2370    # Obtain the path to the database
2371    my $collect_tail = $collect;
2372    $collect_tail =~ s/^.*[\/|\\]//;
2373    my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2374    my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2375
2376    # Read the docid entry
2377    my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2378
2379    # Check to make sure the key does exist
2380    if (!defined ($doc_rec->{$metaname})) {
2381        $gsdl_cgi->generate_error("No metadata field \"" . $metaname . "\" in the specified document: [" . $docid . "]");
2382    }
2383
2384    # Obtain the specified metadata pos
2385    # if no metavalue or metapos to delete, default to deleting the 1st value for the metaname
2386    if(!defined $metapos && !defined $metavalue) {
2387        $metapos = 0;
2388    }
2389   
2390
2391    # consider check key is defined before deleting?
2392    # Loop through the metadata array and ignore the specified position
2393    my $filtered_metadata = [];
2394    my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}});   
2395    for (my $i=0; $i<$num_metadata_vals; $i++) {
2396    my $metaval = shift(@{$doc_rec->{$metaname}});
2397
2398    if (!defined $metavalue && $i != $metapos) {
2399        push(@$filtered_metadata,$metaval);
2400    }
2401   
2402    if(defined $metavalue && !($metavalue eq $metaval))
2403    {
2404        push(@$filtered_metadata,$metaval);
2405    }
2406    }
2407    $doc_rec->{$metaname} = $filtered_metadata;
2408
2409    ## Use the dbutil set_entry method instead of assuming the database is gdbm
2410    my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2411
2412    if ($status != 0) {
2413    my $mess = "Failed to set metadata key: $docid\n";
2414   
2415    $mess .= "PATH: $ENV{'PATH'}\n";
2416    $mess .= "Exit status: $status\n";
2417    $mess .= "System Error Message: $!\n";
2418
2419    $gsdl_cgi->generate_error($mess);
2420    }
2421    else {
2422    my $mess = "DB set (with item deleted) successful: Key[$docid]\n";
2423    $mess .= "  $metaname";
2424    $mess .= "->[$metapos]" if (defined $metapos);
2425    $mess .= " ($metavalue)" if (defined $metavalue);
2426
2427    $gsdl_cgi->generate_ok_message($mess);
2428    }
2429
2430    #return $status; # in case calling functions have a use for this
2431}
2432
2433sub remove_index_metadata
2434{
2435    my $self = shift @_;
2436
2437    my $username  = $self->{'username'};
2438    my $collect   = $self->{'collect'};
2439    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2440#    my $gsdlhome  = $self->{'gsdlhome'};
2441   
2442    if ($baseaction::authentication_enabled) {
2443    # Ensure the user is allowed to edit this collection   
2444    $self->authenticate_user($username, $collect); #&authenticate_user($gsdl_cgi, $username, $collect);
2445    }
2446
2447    # Obtain the collect dir
2448    my $site = $self->{'site'};
2449    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2450    ## my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2451
2452    # Make sure the collection isn't locked by someone else
2453    $self->lock_collection($username, $collect);
2454
2455    $self->_remove_index_metadata(@_);
2456
2457    # Release the lock once it is done
2458    $self->unlock_collection($username, $collect);
2459}
2460
2461
2462# Was trying to reused the codes, but the functions need to be broken
2463# down more before they can be reused, otherwise there will be too
2464# much overhead and duplicate process...
2465sub insert_metadata
2466{
2467    my $self = shift @_;
2468   
2469    my $username  = $self->{'username'};
2470    my $collect   = $self->{'collect'};
2471    my $gsdl_cgi  = $self->{'gsdl_cgi'};
2472    my $gsdlhome  = $self->{'gsdlhome'};
2473    my $infodbtype = $self->{'infodbtype'};
2474   
2475    # If the import metadata and gdbm database have been updated, we
2476    # need to insert some notification to warn user that the the text
2477    # they see at the moment is not indexed and require a rebuild.
2478    my $rebuild_pending_macro = "_rebuildpendingmessage_";
2479
2480    if ($baseaction::authentication_enabled) {
2481    # Ensure the user is allowed to edit this collection
2482    $self->authenticate_user($username, $collect);
2483    }
2484
2485    # Obtain the collect and archive dir   
2486    my $site = $self->{'site'};
2487    my $collect_dir = $gsdl_cgi->get_collection_dir($site);
2488    ##my $collect_dir = &util::filename_cat($gsdlhome, "collect");
2489    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
2490
2491    # Make sure the collection isn't locked by someone else
2492    $self->lock_collection($username, $collect);
2493   
2494    # Check additional args
2495    my $docid = $self->{'d'};
2496    if (!defined($docid) || ($docid =~ m/^\s*$/)) {
2497    $gsdl_cgi->generate_error("No document id is specified: d=...");
2498    }
2499    my $metaname = $self->{'metaname'};
2500    if (!defined($metaname) || ($metaname =~ m/^\s*$/)) {
2501    $gsdl_cgi->generate_error("No metaname is specified: metadataname=...");
2502    }
2503    my $metavalue = $self->{'metavalue'};
2504    if (!defined($metavalue) || ($metavalue =~ m/^\s*$/)) {
2505    $gsdl_cgi->generate_error("No metavalue or empty metavalue is specified: metadataname=...");
2506    }
2507    # make "accumulate" the default (less destructive, as it won't actually
2508    # delete any existing values)
2509    my $metamode = "accumulate";
2510
2511    # metapos/prevmetavalue were never before used in this subroutine, so set them to undefined
2512    my $metapos   = undef;
2513    my $prevmetavalue = undef;
2514
2515    #=======================================================================#
2516    # set_import_metadata [START]
2517    #=======================================================================#
2518    # Obtain where the metadata.xml is from the archiveinfo-doc.gdb file
2519    # If the doc oid is not specified, we assume the metadata.xml is next to the specified "f"
2520    my $metadata_xml_file;
2521    my $arcinfo_doc_filename = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archive_dir);
2522    my $archive_doc_rec = &dbutil::read_infodb_entry($infodbtype, $arcinfo_doc_filename, $docid);
2523   
2524    # This now stores the full pathname
2525    my $import_filename = $archive_doc_rec->{'src-file'}->[0];
2526    $import_filename = &util::placeholders_to_abspath($import_filename);
2527   
2528    # figure out correct metadata.xml file [?]
2529    # Assuming the metadata.xml file is next to the source file
2530    # Note: This will not work if it is using the inherited metadata from the parent folder
2531    my ($import_tailname, $import_dirname)
2532    = File::Basename::fileparse($import_filename);
2533    my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
2534
2535    # Shane's escape characters
2536    $metavalue = pack "U0C*", unpack "C*", $metavalue;
2537    $metavalue =~ s/\,/&#44;/g;
2538    $metavalue =~ s/\:/&#58;/g;
2539    $metavalue =~ s/\|/&#124;/g;
2540    $metavalue =~ s/\(/&#40;/g;
2541    $metavalue =~ s/\)/&#41;/g;
2542    $metavalue =~ s/\[/&#91;/g;
2543    $metavalue =~ s/\\/&#92;/g;
2544    $metavalue =~ s/\]/&#93;/g;
2545    $metavalue =~ s/\{/&#123;/g;
2546    $metavalue =~ s/\}/&#125;/g;
2547    $metavalue =~ s/\"/&#34;/g;
2548    $metavalue =~ s/\`/&#96;/g;
2549    $metavalue =~ s/\n/_newline_/g;
2550
2551    # Edit the metadata.xml
2552    # Modified by Jeffrey from DL Consulting
2553    # Handle the case where there is one metadata.xml file for multiple FileSets
2554    # The XML filter needs to know whether it is in the right FileSet
2555    # TODO: This doesn't fix the problem where the metadata.xml is not next to the src file.
2556    # TODO: This doesn't handle the common metadata (where FileName doesn't point to a single file)
2557    $self->edit_metadata_xml($gsdl_cgi, $metadata_xml_filename, $metaname,
2558                 $metapos, $metavalue, $metamode, $import_tailname, $prevmetavalue);
2559    #=======================================================================#
2560    # set_import_metadata [END]
2561    #=======================================================================#
2562
2563
2564    #=======================================================================#
2565    # set_metadata (accumulate version) [START]
2566    #=======================================================================#
2567    # To people who know $collect_tail please add some comments
2568    # Obtain path to the database
2569    my $collect_tail = $collect;
2570    $collect_tail =~ s/^.*[\/|\\]//;
2571    my $index_text_directory = &util::filename_cat($collect_dir,$collect,"index","text");
2572    my $infodb_file_path = &dbutil::get_infodb_file_path($infodbtype, $collect_tail, $index_text_directory);
2573
2574    # Read the docid entry
2575    my $doc_rec = &dbutil::read_infodb_entry($infodbtype, $infodb_file_path, $docid);
2576
2577    # Protect the quotes
2578    $metavalue =~ s/\"/\\\"/g;
2579
2580    # Adds the pending macro
2581    my $macro_metavalue = $rebuild_pending_macro . $metavalue;
2582
2583    # If the metadata doesn't exist, create a new one
2584    if (!defined($doc_rec->{$metaname})){   
2585    $doc_rec->{$metaname} = [ $macro_metavalue ];
2586    }
2587    # Else, let's acculumate the values
2588    else {
2589        push(@{$doc_rec->{$metaname}},$macro_metavalue);
2590    }
2591
2592    ## Use the dbutil set_entry method instead of assuming the database is gdbm
2593    my $status = &dbutil::set_infodb_entry($infodbtype, $infodb_file_path, $docid, $doc_rec);
2594
2595    if ($status != 0) {
2596        # Catch error if gdbmget failed
2597    my $mess = "Failed to set metadata key: $docid\n";
2598   
2599    $mess .= "PATH: $ENV{'PATH'}\n";
2600    $mess .= "Exit status: $status\n";
2601    $mess .= "System Error Message: $!\n";
2602
2603    $gsdl_cgi->generate_error($mess);
2604    }
2605    else {
2606    my $mess = "insert-metadata successful: Key[$docid]\n";
2607    $mess .= "  [In metadata.xml] $metaname";
2608    $mess .= " = $metavalue\n";
2609    $mess .= "  [In database] $metaname";
2610    $mess .= " = $macro_metavalue\n";
2611    $mess .= "  The new text has not been indexed, rebuilding collection is required\n";
2612        $gsdl_cgi->generate_ok_message($mess);
2613    }   
2614    #=======================================================================#
2615    # set_metadata (accumulate version) [END]
2616    #=======================================================================#
2617
2618    # Release the lock once it is done
2619    $self->unlock_collection($username, $collect);
2620}
2621
2622# not returning 1; here since this file is conditionally included by metadataction.pm
2623# and not otherwise meant to be used on its own
2624
Note: See TracBrowser for help on using the browser.