source: main/trunk/greenstone2/perllib/plugins/GreenstoneXMLPlugin.pm@ 28489

Last change on this file since 28489 was 28267, checked in by davidb, 11 years ago

Code change to allow doc.xml files that do not have a DOCTYPE line
  • Property svn:keywords set to Author Date Id Revision
File size: 11.0 KB
Line 
1
2###########################################################################
3#
4# GreenstoneXMLPlugin.pm
5# A component of the Greenstone digital library software
6# from the New Zealand Digital Library Project at the
7# University of Waikato, New Zealand.
8#
9# Copyright (C) 2001 New Zealand Digital Library Project
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program; if not, write to the Free Software
23# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24#
25###########################################################################
26
27# Processes GreenstoneArchive XML documents. Note that this plugin does no
28# syntax checking (though the XML::Parser module tests for
29# well-formedness). It's assumed that the GreenstoneArchive files conform
30# to their DTD.
31
32package GreenstoneXMLPlugin;
33
34use Encode;
35use File::Basename;
36
37use ReadXMLFile;
38use util;
39use FileUtils;
40
41use strict;
42no strict 'refs'; # allow filehandles to be variables and viceversa
43
44sub BEGIN {
45 @GreenstoneXMLPlugin::ISA = ('ReadXMLFile');
46}
47
48
49
50
51sub get_default_process_exp {
52 my $self = shift (@_);
53
54 return q^(?i)doc(-\d+)?\.xml$^;
55}
56
57my $arguments =
58 [ { 'name' => "process_exp",
59 'desc' => "{BasePlugin.process_exp}",
60 'type' => "regexp",
61 'deft' => &get_default_process_exp(),
62 'reqd' => "no" } ];
63
64my $options = { 'name' => "GreenstoneXMLPlugin",
65 'desc' => "{GreenstoneXMLPlugin.desc}",
66 'abstract' => "no",
67 'inherits' => "yes",
68 'args' => $arguments };
69
70sub new {
71 my ($class) = shift (@_);
72 my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
73 push(@$pluginlist, $class);
74
75 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
76 push(@{$hashArgOptLists->{"OptList"}},$options);
77
78 my $self = new ReadXMLFile($pluginlist, $inputargs, $hashArgOptLists);
79
80 $self->{'section'} = "";
81 $self->{'section_level'} = 0;
82 $self->{'metadata_name'} = "";
83 $self->{'metadata_value'} = "";
84 $self->{'content'} = "";
85 $self->{'metadata_read_store'} = {};
86
87# # Currently used to store information for previous values controls. In
88# # the next contract I'll move to using information directly from Lucene.
89# $self->{'sqlfh'} = 0;
90
91 return bless $self, $class;
92}
93
94
95
96
97sub metadata_read {
98 my $self = shift (@_);
99 my ($pluginfo, $base_dir, $file, $block_hash,
100 $extrametakeys, $extrametadata, $extrametafile,
101 $processor, $gli, $aux) = @_;
102
103 my $outhandle = $self->{'outhandle'};
104
105 # can we process this file??
106 my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file);
107
108 return undef unless $self->can_process_this_file($filename_full_path);
109
110 $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
111
112 print $outhandle "GreenstoneXMLlugin: setting up block list for $file\n"
113 if $self->{'verbosity'} > 1;
114
115 my $line;
116 if (open(GIN,"<:utf8",$filename_full_path)) {
117
118 while (defined($line=<GIN>)) {
119 if ($line =~ m@<Metadata\s+name="gsdlassocfile">([^:]*):(?:[^:]*):(?:[^:]*)</Metadata>@) {
120 my $gsdl_assoc_file = $1;
121
122 my $dirname = dirname($filename_full_path);
123 my $full_gsdl_assoc_filename = &FileUtils::filenameConcatenate($dirname,$gsdl_assoc_file);
124 if ($self->{'verbosity'}>2) {
125 print $outhandle " Storing block list item: $full_gsdl_assoc_filename\n";
126 }
127
128 &util::block_filename($block_hash,$full_gsdl_assoc_filename);
129 }
130 }
131
132 close(GIN);
133 }
134 else {
135
136 print $outhandle "Error: Failed to open $file in GreenstoneXMLPlugin::metadata_read()\n";
137 print $outhandle " $!\n";
138 }
139
140
141 $self->{'metadata_read_store'}->{$filename_full_path} = 1;
142
143 return 1;
144}
145
146
147sub xml_start_document {
148
149 my $self = shift(@_);
150
151 my ($expat, $name, $sysid, $pubid, $internal) = @_;
152
153 my $outhandle = $self->{'outhandle'};
154 print $outhandle "GreenstoneXMLPlugin: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
155 print STDERR "<Processing n='$self->{'file'}' p='GreenstoneXMLPlugin'>\n" if $self->{'gli'};
156
157}
158
159sub xml_end_document {
160}
161
162sub get_doctype {
163 my $self = shift(@_);
164
165 return "(Greenstone)?Archive";
166}
167
168
169sub xml_doctype {
170 my $self = shift(@_);
171
172 my ($expat, $name, $sysid, $pubid, $internal) = @_;
173
174 # Some doc.xml files that have been manipulated by XML::Rules
175 # no longer have the DOCTYPE line. No obvious way to fix
176 # the XML::Rules based code to keep DOCTYPE, so commenting
177 # out the code below to allow doc.xml files with DOCTYPE
178 # to be processed
179
180 # allow the short-lived and badly named "GreenstoneArchive" files to be processed
181 # as well as the "Archive" files which should now be created by import.pl
182## die "" if ($name !~ /^(Greenstone)?Archive$/);
183
184# my $outhandle = $self->{'outhandle'};
185# print $outhandle "GreenstoneXMLPlugin: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
186# print STDERR "<Processing n='$self->{'file'}' p='GreenstoneXMLPlugin'>\n" if $self->{'gli'};
187
188}
189
190
191sub xml_start_tag {
192 my $self = shift(@_);
193 my ($expat, $element) = @_;
194
195 $self->{'element'} = $element;
196 if ($element eq "Section") {
197 if ($self->{'section_level'} == 0) {
198 $self->open_document();
199 } else {
200 my $doc_obj = $self->{'doc_obj'};
201 $self->{'section'} =
202 $doc_obj->insert_section($doc_obj->get_end_child($self->{'section'}));
203 }
204
205 $self->{'section_level'} ++;
206 }
207 elsif ($element eq "Metadata") {
208 $self->{'metadata_name'} = $_{'name'};
209 }
210}
211
212sub xml_end_tag {
213 my $self = shift(@_);
214 my ($expat, $element) = @_;
215
216 if ($element eq "Section") {
217 $self->{'section_level'} --;
218 $self->{'section'} = $self->{'doc_obj'}->get_parent_section ($self->{'section'});
219 $self->close_document() if $self->{'section_level'} == 0;
220 }
221 elsif ($element eq "Metadata") {
222 # text read in by XML::Parser is in Perl's binary byte value
223 # form ... need to explicitly make it UTF-8
224
225
226 my $metadata_name = decode("utf-8",$self->{'metadata_name'});
227 my $metadata_value = decode("utf-8",$self->{'metadata_value'});
228
229 $self->{'doc_obj'}->add_utf8_metadata($self->{'section'},
230 $metadata_name,$metadata_value);
231
232 # Ensure this value is added to the allvalues database in gseditor.
233 # Note that the database constraints prevent multiple occurances of the
234 # same key-value pair.
235 # We write these out to a file, so they can all be commited in one
236 # transaction
237 #if (!$self->{'sqlfh'})
238 # {
239 # my $sql_file = $ENV{'GSDLHOME'} . "/collect/lld/tmp/gseditor.sql";
240 # # If the file doesn't already exist, open it and begin a transaction
241 # my $sql_fh;
242 # if (!-e $sql_file)
243 # {
244 # open($sql_fh, ">" . $sql_file);
245 # print $sql_fh "BEGIN TRANSACTION;\n";
246 # }
247 # else
248 # {
249 # open($sql_fh, ">>" . $sql_file);
250 # }
251 # print STDERR "Opened SQL log\n";
252 # $self->{'sqlfh'} = $sql_fh;
253 # }
254
255 #my $mvalue = $self->{'metadata_value'};
256 #$mvalue =~ s/\'/\'\'/g;
257 #$mvalue =~ s/_claimantsep_/ \& /g;
258
259 #my $fh = $self->{'sqlfh'};
260 #if ($fh)
261 # {
262 # print $fh "INSERT INTO allvalues (mkey, mvalue) VALUES ('" . $self->{'metadata_name'} . "', '" . $mvalue . "');\n";
263 # }
264
265 # Clean Up
266 $self->{'metadata_name'} = "";
267 $self->{'metadata_value'} = "";
268 }
269 elsif ($element eq "Content" && $self->{'content'} ne "") {
270
271 # text read in by XML::Parser is in Perl's binary byte value
272 # form ... need to explicitly make it UTF-8
273 my $content = decode("utf-8",$self->{'content'});
274
275 $self->{'doc_obj'}->add_utf8_text($self->{'section'}, $content);
276 $self->{'content'} = "";
277 }
278 $self->{'element'} = "";
279}
280
281sub xml_text {
282 my $self = shift(@_);
283 my ($expat) = @_;
284
285 if ($self->{'element'} eq "Metadata") {
286 $self->{'metadata_value'} .= $_;
287 }
288 elsif ($self->{'element'} eq "Content") {
289 $self->{'content'} .= $_;
290 }
291}
292
293sub open_document {
294 my $self = shift(@_);
295
296 my $filename = $self->{'filename'};
297
298 # create a new document
299 if (defined $self->{'metadata_read_store'}->{$filename}) {
300 # Being processed as part of *import* phase
301 # (i.e. was in import directory)
302 $self->SUPER::open_document(@_);
303 delete $self->{'metadata_read_store'}->{$filename};
304 }
305 else {
306 # Otherwise being processed as part of the *buildcol* phase
307 # (i.e. named directly by ArchiveInf plugin)
308 $self->{'doc_obj'} = new doc();
309 }
310
311 $self->{'section'} = "";
312}
313
314sub close_document {
315 my $self = shift(@_);
316
317 # add the associated files
318 my $assoc_files =
319 $self->{'doc_obj'}->get_metadata($self->{'doc_obj'}->get_top_section(), "gsdlassocfile");
320
321 # for when "assocfilepath" isn't the same directory that doc.xml is in...
322 my $assoc_filepath_list= $self->{'doc_obj'}->get_metadata($self->{'doc_obj'}->get_top_section(), "assocfilepath");
323
324 my $assoc_filepath=shift (@$assoc_filepath_list);
325
326 #rint STDERR "Filename is: " . $self->{'filename'} . "\n";
327 #rint STDERR "Initially my assoc_filepath is: $assoc_filepath\n";
328 #rint STDERR "Custom archive dir is: " . $self->{'base_dir'} . "\n";
329 # Correct the assoc filepath if one is defined
330 if (defined ($assoc_filepath))
331 {
332 # Check whether the assoc_filepath already includes the base dir
333 if (index($assoc_filepath, $self->{'base_dir'}) == -1)
334 {
335 # And if not, append it so as to make this absolute
336 $assoc_filepath = &FileUtils::filenameConcatenate($self->{'base_dir'}, $assoc_filepath);
337 }
338 }
339 else
340 {
341 $assoc_filepath = $self->{'filename'};
342 $assoc_filepath =~ s/[^\\\/]*$//;
343 }
344 #rint STDERR "Goned and made it absolute: $assoc_filepath\n";
345
346 foreach my $assoc_file_info (@$assoc_files) {
347 my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info);
348 #rint STDERR "assoc_file: $assoc_file\n";
349 #rint STDERR "mime_type: $mime_type\n";
350 #rint STDERR "dir: $dir\n";
351 my $real_dir = &FileUtils::filenameConcatenate($assoc_filepath, $assoc_file),
352 my $assoc_dir = (defined $dir && $dir ne "")
353 ? &FileUtils::filenameConcatenate($dir, $assoc_file) : $assoc_file;
354 $self->{'doc_obj'}->associate_file($real_dir, $assoc_dir, $mime_type);
355 #rint STDERR "According to me the real assoc_filepath is: $real_dir\n";
356 }
357 $self->{'doc_obj'}->delete_metadata($self->{'doc_obj'}->get_top_section(), "gsdlassocfile");
358
359 # process the document
360 $self->{'processor'}->process($self->{'doc_obj'}, $self->{'file'});
361
362 $self->{'num_processed'} ++;
363 undef $self->{'doc_obj'};
364}
365
366
3671;
368
369
Note: See TracBrowser for help on using the repository browser.