root/gsdl/trunk/perllib/cgiactions/metadataaction.pm @ 19293

Revision 19293, 9.2 KB (checked in by davidb, 10 years ago)

Introduction of Perl-based CGI 'actions' plus supporting modules

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
32
33BEGIN {
34    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/perl-5.8");
35    require XML::Rules;
36}
37
38
39@metadataaction::ISA = ('baseaction');
40
41
42
43my $action_table =
44{
45    "get-live-metadata"   => { 'compulsory-args' => [ "d", "metaname" ],
46                   'optional-args'   => [] },
47    "set-live-metadata"   => { 'compulsory-args' => [ "d", "metaname", "metavalue" ],
48                   'optional-args'   => [] },
49    "set-import-metadata" => { 'compulsory-args' => [ "metaname", "metavalue" ],
50                   'optional-args'   => [ "d", "f", "metamode" ]
51                   # metamode can be "accumulate", "override", or "unique-id"
52                   }
53};
54
55
56sub new
57{
58    my $class = shift (@_);
59    my ($gsdl_cgi,$iis6_mode) = @_;
60
61    my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
62
63    return bless $self, $class;
64}
65
66
67
68sub get_live_metadata
69{
70    my $self = shift @_;
71
72    my $username  = $self->{'username'};
73    my $collect   = $self->{'collect'};
74    my $gsdl_cgi  = $self->{'gsdl_cgi'};
75    my $gsdlhome  = $self->{'gsdlhome'};
76
77    my $collect_dir = &util::filename_cat($gsdlhome, "collect");
78#    $gsdl_cgi->checked_chdir($collect_dir);
79
80
81    # Make sure the collection isn't locked by someone else
82    $self->lock_collection($username, $collect);
83
84    # look up additional args
85
86    my $docid  = $self->{'d'};
87    if ((!defined $docid) || ($docid =~ m/^\s*$/)) {
88    $gsdl_cgi->generate_error("No docid (d=...) specified.");
89    }
90
91    my $metaname  = $self->{'metaname'};
92
93    my $dbkey = "$docid.$metaname";
94
95    my $collect_tail = $collect;
96    $collect_tail =~ s/^.*[\/|\\]//;
97
98    my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
99    my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb");
100
101    my $cmd = "gdbmget $gdbm_db $dbkey";
102
103    if (open(GIN,"$cmd |") == 0) {
104    my $mess = "Failed to get metadata key: $metaname\n";
105    $mess .= "$!\n";
106
107    $gsdl_cgi->generate_error($mess);
108    }
109
110    else {
111    my $metavalue = "";
112
113    my $line;
114    while (defined ($line=<GIN>)) {
115        $metavalue .= $line;
116    }
117    close(GIN);
118         
119    $gsdl_cgi->generate_ok_message("$metavalue");
120    }
121
122
123}
124
125
126
127
128sub set_live_metadata
129{
130    my $self = shift @_;
131
132    my $username  = $self->{'username'};
133    my $collect   = $self->{'collect'};
134    my $gsdl_cgi  = $self->{'gsdl_cgi'};
135    my $gsdlhome  = $self->{'gsdlhome'};
136
137
138    # don't user authenticate for now
139    if ($baseaction::authentication_enabled) {
140    # Ensure the user is allowed to edit this collection
141    &authenticate_user($gsdl_cgi, $username, $collect);
142    }
143
144    my $collect_dir = &util::filename_cat($gsdlhome, "collect");
145#    $gsdl_cgi->checked_chdir($collect_dir);
146
147
148    # Make sure the collection isn't locked by someone else
149    $self->lock_collection($username, $collect);
150
151    # look up additional args
152
153    my $docid     = $self->{'d'};
154    my $metaname  = $self->{'metaname'};
155    my $metavalue = $self->{'metavalue'};
156
157    my $dbkey = "$docid.$metaname";
158
159    my $collect_tail = $collect;
160    $collect_tail =~ s/^.*[\/\\]//;
161
162    my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text");
163    my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb");
164
165    my $cmd = "gdbmset \"$gdbm_db\" \"$dbkey\" \"$metavalue\"";
166
167    my $status = system($cmd);
168
169    if ($status != 0) {
170    my $mess = "Failed to set metadata key: $dbkey\n";
171   
172    $mess .= "PATH: $ENV{'PATH'}\n";
173    $mess .= "cmd = $cmd\n";
174    $mess .= "Exit status: $status\n";
175    $mess .= "System Error Message: $!\n";
176
177    $gsdl_cgi->generate_error($mess );
178    }
179    else {
180    $gsdl_cgi->generate_ok_message("DB set successful: Key[$metaname]=$metavalue");
181    }
182
183}
184
185
186
187
188
189sub mxml_metadata
190{
191
192    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
193
194
195    my $metaname = $parser->{'parameters'}->{'metaname'};
196    my $metamode = $parser->{'parameters'}->{'metamode'};
197
198    my $name_attr = $attrHash->{'name'};
199
200    if (($name_attr eq $metaname) && ($metamode eq "override")) {
201
202    my $metavalue = $parser->{'parameters'}->{'metavalue'};
203
204    $attrHash->{'_content'} = $metavalue;
205
206    # Don't want it to wipe out any other pieces of metadata
207    $parser->{'parameters'}->{'metamode'} = "done";
208
209    }
210
211    # raw extended
212    return (':'.$tagname => $attrHash, [$tagname => $attrHash]);
213}
214
215
216sub mxml_description
217{
218
219    my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
220
221    my $metamode = $parser->{'parameters'}->{'metamode'};
222
223
224    if ($metamode eq "accumulate") {
225    # tack a new metadata tag on to the end of the <Metadata>+ block
226
227    my $metaname = $parser->{'parameters'}->{'metaname'};
228    my $metavalue = $parser->{'parameters'}->{'metavalue'};
229   
230
231    my $metadata_attr = { '_content' => $metavalue,
232                  'name'     => $metaname,
233                  'mode'     => "accumulate" };
234
235    my $append_metadata = [ "Metadata" => $metadata_attr ];
236
237    my $description_content = $attrHash->{'_content'};
238
239    push(@$description_content,"    ", $append_metadata ,"\n        ");
240
241    }
242
243    # raw
244    return $tagname => $attrHash;
245}
246
247sub edit_metadata_xml
248{
249    my $self = shift @_;
250
251    my ($gsdl_cgi, $metadata_xml_filename, $file, $metaname, $metavalue, $metamode) = @_;
252
253    # use XML::Rules to add it in (read in and out again)
254
255    my @rules =
256    ( _default => 'raw extended',
257      'Metadata' => \&mxml_metadata,
258      'Description' => \&mxml_description );
259     
260
261    my $parser = XML::Rules->new(rules => \@rules,
262                 style => 'filter' );
263
264
265    my $xml_in = "";
266    if (!open(MIN,"<$metadata_xml_filename")) {
267    $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!");
268    }
269    else {
270    my $line;
271    while (defined ($line=<MIN>)) {
272        $xml_in .= $line;
273    }
274    close(MIN);
275   
276   
277    my $xml_out = "";
278    $parser->filter($xml_in,\$xml_out, { metaname => $metaname,
279                         metavalue => $metavalue,
280                         metamode => $metamode } );
281   
282    if (!open(MOUT,">$metadata_xml_filename")) {
283        $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!");
284    }
285    else {
286        print MOUT $xml_out;
287        close(MOUT);
288       
289    }
290    }
291
292
293
294}
295
296sub set_import_metadata
297{
298    my $self = shift @_;
299
300    my $username  = $self->{'username'};
301    my $collect   = $self->{'collect'};
302    my $gsdl_cgi  = $self->{'gsdl_cgi'};
303    my $gsdlhome  = $self->{'gsdlhome'};
304
305
306    # don't user authenticate for now
307    if ($baseaction::authentication_enabled) {
308    # Ensure the user is allowed to edit this collection
309    $self->authenticate_user($username, $collect);
310    }
311
312    my $collect_dir = &util::filename_cat($gsdlhome, "collect");
313#    $gsdl_cgi->checked_chdir($collect_dir);
314
315    my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives");
316
317
318    # Make sure the collection isn't locked by someone else
319    $self->lock_collection($username, $collect);
320
321    # look up additional args
322
323    # want either d= or f=
324    my $docid  = $self->{'d'};
325    my $import_file  = $self->{'f'};
326
327    if ((!defined $docid) && (!defined $import_file)) {
328    $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified.");
329    }
330
331    my $metaname   = $self->{'metaname'};
332    my $metavalue  = $self->{'metavalue'};
333    my $metamode   = $self->{'metamode'};
334
335    if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) {
336    # make "accumulate" the default (less destructive, as won't actually
337    # delete any existing values)
338
339    $metamode = "accumulate";
340    }
341
342    my $metadata_xml_file;
343
344    if (defined $docid) {
345
346    my $doc_db = "archiveinf-doc.gdb";
347    my $arcinfo_doc_filename = &util::filename_cat ($archive_dir, $doc_db);
348
349    my $doc_rec = GDBMUtils::gdbmRecordToHash($arcinfo_doc_filename,$docid);
350
351    $import_file = $doc_rec->{'src-file'}->[0];
352    }
353   
354
355    my $import_filename = &util::filename_cat($collect_dir,$collect,$import_file);
356
357
358    # Assuming that the metadata field is being indexed, then
359    # **** "touch" (in the Unix sense) $import_filename so we know it needs to
360    # be reindexed?
361    # (to be implemented)
362   
363    # figure out correct metadata.xml file
364
365    my ($import_tailname, $import_dirname)
366    = File::Basename::fileparse($import_filename);
367
368    my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml");
369
370    $self->edit_metadata_xml($gsdl_cgi,$metadata_xml_filename,$import_tailname,
371                 $metaname,$metavalue,$metamode);
372
373}
374
375
3761;
Note: See TracBrowser for help on using the browser.