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

Revision 28064, 116.5 KB (checked in by sjm84, 7 years ago)

Added functionality to use prevmetavalue when setting index metadata

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