root/main/trunk/greenstone2/perllib/plugins/MetadataXMLPlugin.pm @ 24971

Revision 24971, 13.3 KB (checked in by ak19, 8 years ago)

1. Introduced the util::filepath_to_url_format subroutine which will be used to convert filenames to URL style filenames to match the slashes used in the filename regex-es in extrameta keys used to index into extrameta data structures. 2. Fixed bug on windows where metadata.xml specifies filenames as regex with backslash in front of the file extension's period mark: DirectoryPlugin? needed to unregex the filepath before calling fileparse on it, else the escaping backslash would interfere with perl's fileparse routine (only on windows, since backslash also represents a dirsep here). 3. Updated all those perl plugins where the new util::filepath_to_url_format needs to be called so that they use URL style filenames (thereafter regexed) to index into the extrameta data structures.

  • Property svn:keywords set to Author Date Id Revision
Line 
1###########################################################################
2#
3# MetadataXMLPlugin.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) 2006 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26# MetadataXMLPlugin process metadata.xml files in a collection
27
28# Here's an example of a metadata file that uses three FileSet structures
29# (ignore the # characters):
30
31#<?xml version="1.0" encoding="UTF-8" standalone="no"?>
32#<!DOCTYPE DirectoryMetadata SYSTEM "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd">
33#<DirectoryMetadata>
34#  <FileSet>
35#    <FileName>nugget.*</FileName>
36#    <Description>
37#      <Metadata name="Title">Nugget Point, The Catlins</Metadata>
38#      <Metadata name="Place" mode="accumulate">Nugget Point</Metadata>
39#    </Description>
40#  </FileSet>
41#  <FileSet>
42#    <FileName>nugget-point-1.jpg</FileName>
43#    <Description>
44#      <Metadata name="Title">Nugget Point Lighthouse, The Catlins</Metadata>
45#      <Metadata name="Subject">Lighthouse</Metadata>
46#    </Description>
47#  </FileSet>
48#  <FileSet>
49#    <FileName>kaka-point-dir</FileName>
50#    <Description>
51#      <Metadata name="Title">Kaka Point, The Catlins</Metadata>
52#    </Description>
53#  </FileSet>
54#</DirectoryMetadata>
55
56# Metadata elements are read and applied to files in the order they appear
57# in the file.
58#
59# The FileName element describes the subfiles in the directory that the
60# metadata applies to as a perl regular expression (a FileSet group may
61# contain multiple FileName elements). So, <FileName>nugget.*</FileName>
62# indicates that the metadata records in the following Description block
63# apply to every subfile that starts with "nugget".  For these files, a
64# Title metadata element is set, overriding any old value that the Title
65# might have had.
66#
67# Occasionally, we want to have multiple metadata values applied to a
68# document; in this case we use the "mode=accumulate" attribute of the
69# particular Metadata element.  In the second metadata element of the first
70# FileSet above, the "Place" metadata is accumulating, and may therefore be
71# given several values.  If we wanted to override these values and use a
72# single metadata element again, we could set the mode attribute to
73# "override" instead.  Remember: every element is assumed to be in override
74# mode unless you specify otherwise, so if you want to accumulate metadata
75# for some field, every occurance must have "mode=accumulate" specified.
76#
77# The second FileSet element above applies to a specific file, called
78# nugget-point-1.jpg.  This element overrides the Title metadata set in the
79# first FileSet, and adds a "Subject" metadata field.
80#
81# The third and final FileSet sets metadata for a subdirectory rather than
82# a file.  The metadata specified (a Title) will be passed into the
83# subdirectory and applied to every file that occurs in the subdirectory
84# (and to every subsubdirectory and its contents, and so on) unless the
85# metadata is explictly overridden later in the import.
86
87package MetadataXMLPlugin;
88
89use strict;
90no strict 'refs';
91
92use Encode;
93
94use BasePlugin;
95use extrametautil;
96use util;
97use metadatautil;
98
99sub BEGIN {
100    @MetadataXMLPlugin::ISA = ('BasePlugin');
101    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
102}
103
104use XMLParser;
105
106my $arguments = [
107      { 'name' => "process_exp",
108    'desc' => "{BasePlugin.process_exp}",
109    'type' => "regexp",
110    'reqd' => "no",
111    'deft' => &get_default_process_exp() }
112
113];
114
115my $options = { 'name'     => "MetadataXMLPlugin",
116        'desc'     => "{MetadataXMLPlugin.desc}",
117        'abstract' => "no",
118        'inherits' => "yes",
119        'args'     => $arguments };
120
121sub new {
122    my ($class) = shift (@_);
123    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
124    push(@$pluginlist, $class);
125
126    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
127    push(@{$hashArgOptLists->{"OptList"}},$options);
128
129    my $self = new BasePlugin($pluginlist, $inputargs, $hashArgOptLists);
130
131    if ($self->{'info_only'}) {
132    # don't worry about any options or initialisations etc
133    return bless $self, $class;
134    }
135   
136    # The following used to be passed in as a parameter to XML::Parser,
137    # if the version of perl was greater than or equal to 5.8.
138    # The svn commit comment explaining the reason for adding this was
139    # not very clear and also said that it was quick fix and hadn't
140    # been tested under windows.
141    # More recent work has been to make strings in Perl "Unicode-aware"
142    # and so this line might actually be potentially harmful, however
143    # it is not the case that we encountered an actual error leading to
144    # its removal, rather it has been eliminated in an attempt to tighten
145    # up the code. For example, this protocol encoding is not used in
146    # ReadXMLFile.
147    # 'ProtocolEncoding' => 'ISO-8859-1',
148
149    # create XML::Parser object for parsing metadata.xml files
150    my $parser = new XML::Parser('Style' => 'Stream',                             
151                                  'Pkg' => 'MetadataXMLPlugin',
152                                  'PluginObj' => $self,
153                    'Handlers' => {'Char' => \&Char,
154                         'Doctype' => \&Doctype
155                         });
156
157    $self->{'parser'} = $parser;
158    $self->{'in_filename'} = 0;
159   
160   
161    return bless $self, $class;
162}
163
164
165sub get_default_process_exp
166{
167    return q^metadata\.xml$^;
168}
169
170sub get_doctype {
171    my $self = shift(@_);
172   
173    return "(Greenstone)?DirectoryMetadata"
174}
175
176sub can_process_this_file {
177    my $self = shift(@_);
178    my ($filename) = @_;
179
180    if (-f $filename && $self->SUPER::can_process_this_file($filename) && $self->check_doctype($filename)) {
181    return 1; # its a file for us
182    }
183    return 0;
184}
185
186sub check_doctype {
187    my $self = shift (@_);
188   
189    my ($filename) = @_;
190
191    if (open(XMLIN,"<$filename")) {
192    my $doctype = $self->get_doctype();
193    ## check whether the doctype has the same name as the root element tag
194    while (defined (my $line = <XMLIN>)) {
195        ## find the root element
196        if ($line =~ /<([\w\d:]+)[\s>]/){
197        my $root = $1;
198        if ($root !~ $doctype){
199            close(XMLIN);
200            return 0;
201        }
202        else {
203            close(XMLIN);
204            return 1;
205        }
206        }
207    }
208    close(XMLIN);
209    }
210   
211    return undef; # haven't found a valid line
212   
213}
214
215sub file_block_read {
216    my $self = shift (@_);
217    my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $gli) = @_;
218   
219    my $filename_full_path = &util::filename_cat($base_dir, $file);
220    return undef unless $self->can_process_this_file($filename_full_path);   
221
222    if ($ENV{'GSDLOS'} =~ m/^windows$/) {
223       
224        my $lower_drive = $filename_full_path;
225        $lower_drive =~ s/^([A-Z]):/\l$1:/i;
226       
227        my $upper_drive = $filename_full_path;
228        $upper_drive =~ s/^([A-Z]):/\u$1:/i;
229       
230        $block_hash->{'metadata_files'}->{$lower_drive} = 1;
231        $block_hash->{'metadata_files'}->{$upper_drive} = 1;       
232    }
233    else {
234        $block_hash->{'metadata_files'}->{$filename_full_path} = 1;
235    }
236
237    return 1;
238}
239
240sub metadata_read
241{
242    my $self = shift (@_);
243    my ($pluginfo, $base_dir, $file, $block_hash,
244    $extrametakeys, $extrametadata,$extrametafile,
245    $processor, $gli, $aux) = @_;
246
247    my $filename = &util::filename_cat($base_dir, $file);
248    return undef unless $self->can_process_this_file($filename);   
249   
250    $self->{'metadata-file'} = $file;
251    $self->{'metadata-filename'} = $filename;
252   
253    my $outhandle = $self->{'outhandle'};
254   
255    print STDERR "\n<Processing n='$file' p='MetadataXMLPlugin'>\n" if ($gli);
256    print $outhandle "MetadataXMLPlugin: processing $file\n" if ($self->{'verbosity'})> 1;
257    # add the file to the block list so that it won't be processed in read, as we will do all we can with it here
258    &util::block_filename($block_hash,$filename);
259
260    $self->{'metadataref'} = $extrametadata;
261    $self->{'metafileref'} = $extrametafile;
262    $self->{'metakeysref'} = $extrametakeys;
263   
264    eval {
265    $self->{'parser'}->parsefile($filename);
266    };
267
268    if ($@) {
269    print STDERR "**** Error is: $@\n";
270    my $plugin_name = ref ($self);
271    my $failhandle = $self->{'failhandle'};
272    print $outhandle "$plugin_name failed to process $file ($@)\n";
273    print $failhandle "$plugin_name failed to process $file ($@)\n";
274    print STDERR "<ProcessingError n='$file'>\n" if ($gli);
275    return -1; #error
276    }
277
278    return 1;
279
280}
281
282
283# Updated by Jeffrey 2010/04/16 @ DL Consulting Ltd.
284# Get rid off the global $self as it cause problems when there are 2+ MetadataXMLPlugin in your collect.cfg...
285# For example when you have an OAIMetadataXMLPlugin that is a child of MetadataXMLPlugin
286sub Doctype {$_[0]->{'PluginObj'}->xml_doctype(@_);}
287sub StartTag {$_[0]->{'PluginObj'}->xml_start_tag(@_);}
288sub EndTag {$_[0]->{'PluginObj'}->xml_end_tag(@_);}
289sub Text {$_[0]->{'PluginObj'}->xml_text(@_);}
290
291
292sub xml_doctype {
293    my $self = shift(@_);
294    my ($expat, $name, $sysid, $pubid, $internal) = @_;
295
296    # allow the short-lived and badly named "GreenstoneDirectoryMetadata" files
297    # to be processed as well as the "DirectoryMetadata" files which should now
298    # be created by import.pl
299    die if ($name !~ /^(Greenstone)?DirectoryMetadata$/);
300}
301
302sub xml_start_tag {
303    my $self = shift(@_);
304    my ($expat, $element) = @_;
305   
306    if ($element eq "FileSet") {
307    $self->{'saved_targets'} = [];
308    $self->{'saved_metadata'} = {};
309    }
310    elsif ($element eq "FileName") {
311    $self->{'in_filename'} = 1;
312    }
313    elsif ($element eq "Metadata") {
314    $self->{'metadata_name'} = $_{'name'};
315    $self->{'metadata_value'} = "";
316    if ((defined $_{'mode'}) && ($_{'mode'} eq "accumulate")) {
317        $self->{'metadata_accumulate'} = 1;
318    } else {
319        $self->{'metadata_accumulate'} = 0;
320    }
321    }
322}
323
324sub xml_end_tag {
325    my $self = shift(@_);
326    my ($expat, $element) = @_;
327
328    if ($element eq "FileSet") {
329    foreach my $target (@{$self->{'saved_targets'}}) {
330   
331        # Indexing into the extrameta data structures requires the filename's style of slashes to be in URL
332        # format. But if metadata.xml was user-constructed, its FileName fields (stored in the saved_targets
333        # map) could represent pathnames in Windows format using \ as file separator, instead of pathnames
334        # being in URL format as Greenstone would've generated. Need to convert such filepaths to URL style
335        # paths. Then need convert this to a regex to protect special characters like brackets in the
336        # filepath, such as "C:\Program Files (x86)\Greenstone".
337       
338        $target = &util::unregex_filename($target); # filename is a regex, before converting it to URL form, unregex it
339        $target = &util::filepath_to_url_format($target); # convert to URL form
340        $target = &util::filename_to_regex($target); # regex it. Now we have regexed URL form of filename
341   
342        my $file_metadata = &extrametautil::getmetadata($self->{'metadataref'}, $target);
343        my $saved_metadata = $self->{'saved_metadata'};
344
345        if (!defined $file_metadata) {
346        &extrametautil::setmetadata($self->{'metadataref'}, $target, $saved_metadata);
347
348        # not had target before
349        &extrametautil::addmetakey($self->{'metakeysref'}, $target);
350        }
351        else {
352        &metadatautil::combine_metadata_structures($file_metadata,$saved_metadata);
353        }
354
355       
356        # now record which metadata.xml file it came from
357
358        my $file = $self->{'metadata-file'};
359        my $filename = $self->{'metadata-filename'};
360
361        if (!defined &extrametautil::getmetafile($self->{'metafileref'}, $target)) {
362            &extrametautil::setmetafile($self->{'metafileref'}, $target, {});
363        }
364
365        &extrametautil::setmetafile_for_named_file($self->{'metafileref'}, $target, $file, $filename);
366    }
367    }
368    elsif ($element eq "FileName") {
369    $self->{'in_filename'} = 0;
370    }
371    elsif ($element eq "Metadata") {
372    # text read in by XML::Parser is in Perl's binary byte value
373    # form ... need to explicitly make it UTF-8
374   
375    my $metadata_name = decode("utf-8",$self->{'metadata_name'});
376    my $metadata_value = decode("utf-8",$self->{'metadata_value'});
377   
378    &metadatautil::store_saved_metadata($self,
379                        $metadata_name, $metadata_value,
380                        $self->{'metadata_accumulate'});
381    $self->{'metadata_name'} = "";
382    }
383
384}
385
386sub xml_text {
387    my $self = shift(@_);
388
389    if ($self->{'in_filename'}) {
390    # $_ == FileName content
391    push (@{$self->{'saved_targets'}}, $_);
392    }
393    elsif (defined ($self->{'metadata_name'}) && $self->{'metadata_name'} ne "") {
394    # $_ == Metadata content
395    $self->{'metadata_value'} = $_;
396    }
397}
398
399# This Char function overrides the one in XML::Parser::Stream to overcome a
400# problem where $expat->{Text} is treated as the return value, slowing
401# things down significantly in some cases.
402sub Char {
403    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
404
405#    if ($]<5.008) {
406#   use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+ and Perl 5.6
407#    }
408    $_[0]->{'Text'} .= $_[1];
409    return undef;
410}
411
412
413
4141;
Note: See TracBrowser for help on using the browser.