source: trunk/gsdl/perllib/plugins/HBSPlug.pm@ 1991

Last change on this file since 1991 was 1424, checked in by sjboddie, 24 years ago

Added a -out option to most of the perl building scripts to allow output
debug information to be directed to a file.

  • Property svn:keywords set to Author Date Id Revision
File size: 6.3 KB
Line 
1###########################################################################
2#
3# HBSPlug.pm -- plugin for processing simple html (or text) books
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) 1999 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# creates multi-level document from document containing
27# <<TOC>> level tags. Metadata for each section is taken from any
28# other tags on the same line as the <<TOC>>. e.g. <<Title>>xxxx<</Title>>
29# sets Title metadata.
30
31# Everything else between TOC tags is treated as simple html (i.e. no
32# processing of html links or any other HTMLPlug type stuff is done).
33
34# expects input files to have a .hb file extension by default (this can be
35# changed by adding a -process_exp option
36
37# a file with the same name as the hb file but a .jpg extension is
38# taken as the cover image (jpg files are blocked by this plugin)
39
40# HBSPlug is a simplification (and extension of) the HBPlug used
41# by the Humanity Library collections. HBSPlug is faster as it expects
42# the input files to be cleaner (The input to the HDL collections
43# contains lots of excess html tags around <<TOC>> tags, uses <<I>>
44# tags to specify images, and simply takes all text between <<TOC>>
45# tags and start of text to be Title metadata). If you're marking up
46# documents to be displayed in the same way as the HDL collections,
47# use this plugin instead of HBPlug.
48
49package HBSPlug;
50
51use BasPlug;
52use util;
53
54sub BEGIN {
55 @ISA = ('BasPlug');
56}
57
58sub new {
59 my ($class) = @_;
60 my $self = new BasPlug ("HBSPlug", @_);
61
62 return bless $self, $class;
63}
64
65sub get_default_block_exp {
66 my $self = shift (@_);
67
68 return q^\.jpg$^;
69}
70
71sub get_default_process_exp {
72 my $self = shift (@_);
73
74 return q^(?i)\.hb$^;
75}
76
77# do plugin specific processing of doc_obj
78sub process {
79 my $self = shift (@_);
80 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
81 my $outhandle = $self->{'outhandle'};
82
83 print $outhandle "HBSPlug: processing $file\n"
84 if $self->{'verbosity'} > 1;
85
86 my $cursection = $doc_obj->get_top_section();
87
88 my $filename = &util::filename_cat($base_dir, $file);
89 my $absdir = $filename;
90 $absdir =~ s/[^\/\\]*$//;
91
92 # add the cover image
93 my $coverimage = $filename;
94 $coverimage =~ s/\.[^\.]*$/\.jpg/i;
95 $doc_obj->associate_file($coverimage, "cover.jpg", "image/jpeg");
96
97 my $title = "";
98
99 # remove any leading rubbish
100 $$textref =~ s/^.*?(<<TOC)/$1/ios;
101
102 my $curtoclevel = 1;
103 my $firstsection = 1;
104 my $toccount = 0;
105 while ($$textref =~ /\w/) {
106 $$textref =~ s/^<<TOC(\d+)>>([^\n]*)\n(.*?)(<<TOC|\Z)/$4/ios;
107 my $toclevel = $1;
108 my $metadata = $2;
109 my $sectiontext = $3;
110
111 if ($toclevel == 2) {
112 $toccount ++;
113 }
114
115 # close any sections below the current level and
116 # create a new section (special case for the firstsection)
117 while (($curtoclevel > $toclevel) ||
118 (!$firstsection && $curtoclevel == $toclevel)) {
119 $cursection = $doc_obj->get_parent_section ($cursection);
120 $curtoclevel--;
121 }
122 if ($curtoclevel+1 < $toclevel) {
123 print $outhandle "WARNING - jump in toc levels in $filename " .
124 "from $curtoclevel to $toclevel\n";
125 }
126 while ($curtoclevel < $toclevel) {
127 $curtoclevel++;
128 $cursection =
129 $doc_obj->insert_section($doc_obj->get_end_child($cursection));
130 }
131
132 # sort out metadata
133 while ($metadata =~ s/^.*?<<([^>]*)>>(.*?)<<[^>]*>>//) {
134 my $metakey = $1;
135 my $metavalue = $2;
136
137 if ($metavalue ne "" && $metakey ne "") {
138 # make sure key fits in with gsdl naming scheme
139 $metakey =~ tr/[A-Z]/[a-z]/;
140 $metakey = ucfirst ($metakey);
141 $doc_obj->add_utf8_metadata ($cursection, $metakey, $metavalue);
142 }
143 }
144
145 # remove header rubbish
146 $sectiontext =~ s/^.*?<body[^>]*>//ios;
147
148 # and any other unwanted tags
149 $sectiontext =~ s/<(\/p|\/html|\/body)>//isg;
150
151 # fix up the image links
152 $sectiontext =~ s/(<img[^>]*?src\s*=\s*\"?)([^\">]+)(\"?[^>]*>)/
153 &replace_image_links($absdir, $doc_obj, $1, $2, $3)/isge;
154
155 # add the text
156 $doc_obj->add_utf8_text($cursection, $sectiontext);
157
158 $firstsection = 0;
159
160 $$textref =~ s/^\s+//s;
161 }
162
163 return 1;
164}
165
166sub replace_image_links {
167 my ($dir, $doc_obj, $front, $link, $back) = @_;
168 my $outhandle = $self->{'outhandle'};
169
170 my ($filename, $error);
171 my $foundimage = 0;
172
173 $link =~ s/\/\///;
174 my ($imagetype) = $link =~ /([^\.]*)$/;
175 $imagetype =~ tr/[A-Z]/[a-z]/;
176 if ($imagetype eq "jpg") {$imagetype = "jpeg";}
177 if ($imagetype !~ /^(jpeg|gif|png)$/) {
178 print $outhandle "HBSPlug: Warning - unknown image type ($imagetype)\n";
179 }
180 my ($imagefile) = $link =~ /([^\/]*)$/;
181 my ($imagepath) = $link =~ /^[^\/]*(.*)$/;
182
183 if (defined $imagepath && $imagepath =~ /\w/) {
184 # relative link
185 $filename = &util::filename_cat ($dir, $imagepath);
186 if (-e $filename) {
187 $doc_obj->associate_file ($filename, $imagefile, "image/$imagetype");
188 $foundimage = 1;
189 } else {
190 $error = "HBSPlug: Warning - couldn't find image file $imagefile in either $filename or";
191 }
192 }
193
194 if (!$foundimage) {
195 $filename = &util::filename_cat ($dir, $imagefile);
196 if (-e $filename) {
197 $doc_obj->associate_file ($filename, $imagefile, "image/$imagetype");
198 $foundimage = 1;
199 } elsif (defined $error) {
200 print $outhandle "$error $filename\n";
201 } else {
202 print $outhandle "HBSPlug: Warning - couldn't find image file $imagefile in $filename\n";
203 }
204 }
205
206 if ($foundimage) {
207 return "${front}_httpdocimg_/${imagefile}${back}";
208 } else {
209 return "";
210 }
211}
212
2131;
Note: See TracBrowser for help on using the repository browser.