source: gsdl/trunk/perllib/plugins/ReadXMLFile.pm@ 20830

Last change on this file since 20830 was 20830, checked in by kjdon, 13 years ago

save filename_no_path and use it to call set_Source_metadata for doc_obj in open document. all other plugins do this. prevents lots of undefined variable errors later on.

  • Property svn:keywords set to Author Date Id Revision
File size: 11.3 KB
Line 
1###########################################################################
2#
3# ReadXMLFile.pm -- base class for XML plugins
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) 2001 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
26package ReadXMLFile;
27
28use BasePlugin;
29use doc;
30use strict;
31no strict 'refs'; # allow filehandles to be variables and viceversa
32
33sub BEGIN {
34 @ReadXMLFile::ISA = ('BasePlugin');
35 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
36}
37
38use XMLParser;
39
40my $arguments =
41 [ { 'name' => "process_exp",
42 'desc' => "{BasePlugin.process_exp}",
43 'type' => "regexp",
44 'deft' => &get_default_process_exp(),
45 'reqd' => "no" },
46 { 'name' => "xslt",
47 'desc' => "{ReadXMLFile.xslt}",
48 'type' => "string",
49 'deft' => "",
50 'reqd' => "no" } ];
51
52my $options = { 'name' => "ReadXMLFile",
53 'desc' => "{ReadXMLFile.desc}",
54 'abstract' => "yes",
55 'inherits' => "yes",
56 'args' => $arguments };
57
58sub new {
59 my ($class) = shift (@_);
60 my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
61 push(@$pluginlist, $class);
62
63 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
64 push(@{$hashArgOptLists->{"OptList"}},$options);
65
66 my $self = new BasePlugin($pluginlist, $inputargs, $hashArgOptLists);
67
68 if ($self->{'info_only'}) {
69 # don't worry about creating the XML parser as all we want is the
70 # list of plugin options
71 return bless $self, $class;
72 }
73
74 my $parser = new XML::Parser('Style' => 'Stream',
75 'Pkg' => 'ReadXMLFile',
76 'PluginObj' => $self,
77 'Handlers' => {'Char' => \&Char,
78 'XMLDecl' => \&XMLDecl,
79 'Entity' => \&Entity,
80 'Doctype' => \&Doctype,
81 'Default' => \&Default
82 });
83
84 $self->{'parser'} = $parser;
85
86 return bless $self, $class;
87}
88
89# the inheriting class must implement this method to tell whether to parse this doc type
90sub get_doctype {
91 my $self = shift(@_);
92 die "$self The inheriting class must implement get_doctype method";
93}
94
95
96sub apply_xslt
97{
98 my $self = shift @_;
99 my ($xslt,$filename) = @_;
100
101 my $outhandle = $self->{'outhandle'};
102
103 my $xslt_filename = $xslt;
104
105 if (! -e $xslt_filename) {
106 # Look in main site directory
107 my $gsdlhome = $ENV{'GSDLHOME'};
108 $xslt_filename = &util::filename_cat($gsdlhome,$xslt);
109 }
110
111 if (! -e $xslt_filename) {
112 # Look in collection directory
113 my $coldir = $ENV{'GSDLCOLLECTDIR'};
114 $xslt_filename = &util::filename_cat($coldir,$xslt);
115 }
116
117 if (! -e $xslt_filename) {
118 print $outhandle "Warning: Unable to find XSLT $xslt\n";
119 if (open(XMLIN,"<$filename")) {
120
121 my $untransformed_xml = "";
122 while (defined (my $line = <XMLIN>)) {
123
124 $untransformed_xml .= $line;
125 }
126 close(XMLIN);
127
128 return $untransformed_xml;
129 }
130 else {
131 print $outhandle "Error: Unable to open file $filename\n";
132 print $outhandle " $!\n";
133 return "";
134 }
135
136 }
137
138 my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
139 my $jar_filename = &util::filename_cat($bin_java,"xalan.jar");
140 my $xslt_base_cmd = "java -jar $jar_filename";
141 my $xslt_cmd = "$xslt_base_cmd -IN \"$filename\" -XSL \"$xslt_filename\"";
142
143 my $transformed_xml = "";
144
145 if (open(XSLT_IN,"$xslt_cmd |")) {
146 while (defined (my $line = <XSLT_IN>)) {
147
148 $transformed_xml .= $line;
149 }
150 close(XSLT_IN);
151 }
152 else {
153 print $outhandle "Error: Unable to run command $xslt_cmd\n";
154 print $outhandle " $!\n";
155 }
156
157 return $transformed_xml;
158
159}
160
161sub can_process_this_file {
162 my $self = shift(@_);
163 my ($filename) = @_;
164
165 if (-f $filename && $self->SUPER::can_process_this_file($filename) && $self->check_doctype($filename)) {
166 return 1; # its a file for us
167 }
168 return 0;
169}
170
171sub check_doctype {
172 my $self = shift (@_);
173
174 my ($filename) = @_;
175
176 if (open(XMLIN,"<$filename")) {
177 my $doctype = $self->get_doctype();
178 ## check whether the doctype has the same name as the root element tag
179 while (defined (my $line = <XMLIN>)) {
180 ## find the root element
181 if ($line =~ /<([\w\d:]+)[\s>]/){
182 my $root = $1;
183 if ($root !~ $doctype){
184 close(XMLIN);
185 return 0;
186 }
187 else {
188 close(XMLIN);
189 return 1;
190 }
191 }
192 }
193 close(XMLIN);
194 }
195
196 return undef; # haven't found a valid line
197
198}
199
200sub read {
201 my $self = shift (@_);
202
203 my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
204
205 # can we process this file??
206 my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file);
207 return undef unless $self->can_process_this_file($filename_full_path);
208
209 $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
210 $self->{'base_dir'} = $base_dir;
211 $self->{'file'} = $file;
212 $self->{'filename'} = $filename_full_path;
213 $self->{'filename_no_path'} = $filename_no_path;
214 $self->{'processor'} = $processor;
215 # this contains metadata passed in from running metadata_read with other plugins (eg from MetadataXMLPlugin)
216 # we are also using it to store up any metadata found during parsing the XML, so that it can be added to the doc obj.
217 $self->{'metadata'} = $metadata;
218
219 if ($self->parse_file($filename_full_path)) {
220 return 1; # processed the file
221 }
222 return -1;
223}
224
225
226sub parse_file {
227 my $self = shift (@_);
228 my ($filename_full_path, $file, $gli) = @_;
229 eval {
230 my $xslt = $self->{'xslt'};
231 if (defined $xslt && ($xslt ne "")) {
232 # perform xslt
233 my $transformed_xml = $self->apply_xslt($xslt,$filename_full_path);
234
235 # feed transformed file (now in memory as string) into XML parser
236 $self->{'parser'}->parse($transformed_xml);
237 }
238 else {
239 $self->{'parser'}->parsefile($filename_full_path);
240 }
241 };
242
243 if ($@) {
244
245 # parsefile may either croak somewhere in XML::Parser (e.g. because
246 # the document is not well formed) or die somewhere in ReadXMLFile or a
247 # derived plugin (e.g. because we're attempting to process a
248 # document whose DOCTYPE is not meant for this plugin). For the
249 # first case we'll print a warning and continue, for the second
250 # we'll just continue quietly
251
252 print STDERR "**** Error is: $@\n";
253
254 my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
255 if (defined $msg) {
256 my $outhandle = $self->{'outhandle'};
257 my $plugin_name = ref ($self);
258 print $outhandle "$plugin_name failed to process $file ($msg)\n";
259 }
260
261 # reset ourself for the next document
262 $self->{'section_level'}=0;
263 print STDERR "<ProcessingError n='$file'>\n" if ($gli);
264 return -1; # error during processing
265 }
266 return 1; # parsing was successful
267}
268
269sub get_default_process_exp {
270 my $self = shift (@_);
271
272 return q^(?i)\.xml$^;
273}
274
275sub StartDocument {$_[0]->{'PluginObj'}->xml_start_document(@_);}
276sub XMLDecl {$_[0]->{'PluginObj'}->xml_xmldecl(@_);}
277sub Entity {$_[0]->{'PluginObj'}->xml_entity(@_);}
278sub Doctype {$_[0]->{'PluginObj'}->xml_doctype(@_);}
279sub StartTag {$_[0]->{'PluginObj'}->xml_start_tag(@_);}
280sub EndTag {$_[0]->{'PluginObj'}->xml_end_tag(@_);}
281sub Text {$_[0]->{'PluginObj'}->xml_text(@_);}
282sub PI {$_[0]->{'PluginObj'}->xml_pi(@_);}
283sub EndDocument {$_[0]->{'PluginObj'}->xml_end_document(@_);}
284sub Default {$_[0]->{'PluginObj'}->xml_default(@_);}
285
286# This Char function overrides the one in XML::Parser::Stream to overcome a
287# problem where $expat->{Text} is treated as the return value, slowing
288# things down significantly in some cases.
289sub Char {
290 use bytes; # Necessary to prevent encoding issues with XML::Parser 2.31+
291 $_[0]->{'Text'} .= $_[1];
292 return undef;
293}
294
295
296# Called at the beginning of the XML document.
297sub xml_start_document {
298 my $self = shift(@_);
299 my ($expat) = @_;
300
301 $self->open_document();
302}
303
304# Called for XML declarations
305sub xml_xmldecl {
306 my $self = shift(@_);
307 my ($expat, $version, $encoding, $standalone) = @_;
308}
309
310# Called for XML entities
311sub xml_entity {
312 my $self = shift(@_);
313 my ($expat, $name, $val, $sysid, $pubid, $ndata) = @_;
314}
315
316# Called for DOCTYPE declarations - use die to bail out if this doctype
317# is not meant for this plugin
318sub xml_doctype {
319 my $self = shift(@_);
320
321 my ($expat, $name, $sysid, $pubid, $internal) = @_;
322 die "ReadXMLFile Cannot process XML document with DOCTYPE of $name";
323}
324
325
326# Called for every start tag. The $_ variable will contain a copy of the
327# tag and the %_ variable will contain the element's attributes.
328sub xml_start_tag {
329 my $self = shift(@_);
330 my ($expat, $element) = @_;
331}
332
333# Called for every end tag. The $_ variable will contain a copy of the tag.
334sub xml_end_tag {
335 my $self = shift(@_);
336 my ($expat, $element) = @_;
337}
338
339# Called just before start or end tags with accumulated non-markup text in
340# the $_ variable.
341sub xml_text {
342 my $self = shift(@_);
343 my ($expat) = @_;
344}
345
346# Called for processing instructions. The $_ variable will contain a copy
347# of the pi.
348sub xml_pi {
349 my $self = shift(@_);
350 my ($expat, $target, $data) = @_;
351}
352
353# Called at the end of the XML document.
354sub xml_end_document {
355 my $self = shift(@_);
356 my ($expat) = @_;
357
358 $self->close_document();
359}
360
361# Called for any characters not handled by the above functions.
362sub xml_default {
363 my $self = shift(@_);
364 my ($expat, $text) = @_;
365}
366
367sub open_document {
368 my $self = shift(@_);
369
370 # create a new document
371 $self->{'doc_obj'} = new doc ($self->{'filename'}, "indexed_doc", $self->{'file_rename_method'});
372 $self->{'doc_obj'}->add_utf8_metadata($self->{'doc_obj'}->get_top_section(), "Plugin", "$self->{'plugin_type'}");
373 $self->set_Source_metadata($self->{'doc_obj'}, $self->{'filename_no_path'});
374
375
376 # do we want other auto metadata here (see BasePlugin.read_into_doc_obj)
377}
378
379sub close_document {
380 my $self = shift(@_);
381 my $doc_obj = $self->{'doc_obj'};
382
383 # do we want other auto stuff here, see BasePlugin.read_into_doc_obj
384
385 # include any metadata passed in from previous plugins
386 # note that this metadata is associated with the top level section
387 $self->extra_metadata ($doc_obj,
388 $doc_obj->get_top_section(),
389 $self->{'metadata'});
390
391 # do any automatic metadata extraction
392 $self->auto_extract_metadata ($doc_obj);
393
394 # add an OID
395 $self->add_OID($doc_obj);
396
397 $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
398 $doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "XML");
399
400 # process the document
401 $self->{'processor'}->process($doc_obj);
402
403 $self->{'num_processed'} ++;
404 undef $self->{'doc_obj'};
405 undef $doc_obj; # is this the same as above??
406}
407
4081;
409
410
411
412
Note: See TracBrowser for help on using the repository browser.