source: trunk/gsdl/perllib/plugins/BasPlug.pm@ 2795

Last change on this file since 2795 was 2795, checked in by sjboddie, 23 years ago

Got ZIPPlug working under under windows

  • Property svn:keywords set to Author Date Id Revision
File size: 24.5 KB
Line 
1###########################################################################
2#
3# BasPlug.pm -- base class for all the import 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) 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
26package BasPlug;
27
28# suppress the annoying "subroutine redefined" warning that various
29# plugins cause under perl 5.6
30$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
31
32use Kea;
33use parsargv;
34use multiread;
35use encodings;
36use cnseg;
37use acronym;
38use textcat;
39use doc;
40use diagnostics;
41use DateExtract;
42use ghtml;
43
44sub print_general_usage {
45 my ($plugin_name) = @_;
46
47 print STDERR "\n usage: plugin $plugin_name [options]\n\n";
48
49 print STDERR " -process_exp A perl regular expression to match against filenames.\n";
50 print STDERR " Matching filenames will be processed by this plugin.\n";
51 print STDERR " Each plugin has its own default process_exp. e.g HTMLPlug\n";
52 print STDERR " defaults to '(?i)\.html?\$' i.e. all documents ending in\n";
53 print STDERR " .htm or .html (case-insensitive).\n\n";
54
55 print STDERR " -block_exp Files matching this regular expression will be blocked from\n";
56 print STDERR " being passed to any later plugins in the list. This has no\n";
57 print STDERR " real effect other than to prevent lots of warning messages\n";
58 print STDERR " about input files you don't care about. Each plugin might\n";
59 print STDERR " have a default block_exp. e.g. by default HTMLPlug blocks\n";
60 print STDERR " any files with .gif, .jpg, .jpeg, .png or .css\n";
61 print STDERR " file extensions.\n\n";
62
63
64 print STDERR " -input_encoding The encoding of the source documents. Documents will be\n";
65 print STDERR " converted from these encodings and stored internally as\n";
66 print STDERR " utf8. The default input_encoding is 'auto'. Accepted values\n";
67 print STDERR " are:\n";
68
69 print STDERR " auto: Use text categorization algorithm to automatically\n";
70 print STDERR " identify the encoding of each source document. This\n";
71 print STDERR " will be slower than explicitly setting the encoding\n";
72 print STDERR " but will work where more than one encoding is used\n";
73 print STDERR " within the same collection.\n";
74
75 print STDERR " ascii: Plain 7 bit ascii. This may be a bit faster than\n";
76 print STDERR " using iso_8859_1. Beware of using this on a collection\n";
77 print STDERR " of documents that may contain characters outside the\n";
78 print STDERR " plain 7 bit ascii set though (e.g. German or French\n";
79 print STDERR " documents containing accents), use iso_8859_1 instead.\n";
80
81 print STDERR " utf8: either utf8 or unicode -- automatically detected\n";
82 print STDERR " unicode: just unicode\n";
83
84 my $e = $encodings::encodings;
85 foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
86 print STDERR " $enc: $e->{$enc}->{'name'}\n";
87 }
88 print STDERR "\n";
89 print STDERR " -default_encoding Use this encoding if -input_encoding is set to 'auto' and\n";
90 print STDERR " the text categorization algorithm fails to extract the\n";
91 print STDERR " encoding or extracts an encoding unsupported by Greenstone.\n";
92 print STDERR " The default is iso_8859_1.\n\n";
93
94 print STDERR " -extract_language Identify the language of each document and set 'Language'\n";
95 print STDERR " metadata. Note that this will be done automatically if\n";
96 print STDERR " -input_encoding is 'auto'.\n\n";
97 print STDERR " -default_language If Greenstone fails to work out what language a document is\n";
98 print STDERR " the 'Language' metadata element will be set to this value.\n";
99 print STDERR " The default is 'en' (ISO 639 language symbols are used:\n";
100 print STDERR " en = English). Note that if -input_encoding is not set to\n";
101 print STDERR " 'auto' and -extract_language is not set, all documents will\n";
102 print STDERR " have their 'Language' metadata set to this value.\n\n";
103
104 print STDERR " -extract_acronyms Extract acronyms from within text and set as metadata\n";
105
106 print STDERR " -markup_acronyms Add acronym metadata into document text\n\n";
107
108 print STDERR " -first Comma separated list of first sizes to extract from the\n";
109 print STDERR " text into a metadata field. The field is called 'FirstNNN'.\n\n";
110
111 print STDERR " -extract_email Extract email addresses as metadata\n\n";
112
113 print STDERR " -extract_date Extract dates pertaining to the content of documents about\n";
114 print STDERR " history\n";
115 print STDERR " -maximum_date The maximum historical date to be used as metadata (in a\n";
116 print STDERR " Common Era date, such as 1950)\n";
117 print STDERR " -maximum_century The maximum named century to be extracted as historical\n";
118 print STDERR " metadata (e.g. 14 will extract all references up to the\n";
119 print STDERR " 14th century)\n";
120 print STDERR " -no_bibliography Do not try and block bibliographic dates when extracting\n";
121 print STDERR " historical dates.\n\n";
122}
123
124# print_usage should be overridden for any sub-classes having
125# their own plugin specific options
126sub print_usage {
127 print STDERR "\nThis plugin has no plugin specific options\n\n";
128}
129
130sub new {
131 my $class = shift (@_);
132 my $plugin_name = shift (@_);
133 my $self = {};
134
135 my $enc = "^(";
136 map {$enc .= "$_|";} keys %$encodings::encodings;
137 my $denc = $enc . "ascii|utf8|unicode)\$";
138 $enc .= "ascii|utf8|unicode|auto)\$";
139
140 $self->{'outhandle'} = STDERR;
141 my $year = (localtime)[5]+1900;
142
143 $self->{'textcat'} = new textcat();
144
145 $self->{'num_processed'} = 0;
146 $self->{'num_not_processed'} = 0;
147 $self->{'num_blocked'} = 0;
148 $self->{'num_archives'} = 0;
149
150 # general options available to all plugins
151 if (!parsargv::parse(\@_,
152 q^process_exp/.*/^, \$self->{'process_exp'},
153 q^block_exp/.*/^, \$self->{'block_exp'},
154 q^extract_acronyms^, \$self->{'extract_acronyms'},
155 q^extract_keyphrases^, \$self->{'kea'}, #with extra options
156 q^extract_keyphrase_options/.*/^, \$self->{'kea_options'}, #no extra options
157 qq^input_encoding/$enc/auto^, \$self->{'input_encoding'},
158 qq^default_encoding/$denc/iso_8859_1^, \$self->{'default_encoding'},
159 q^extract_email^, \$self->{'extract_email'},
160 q^markup_acronyms^, \$self->{'markup_acronyms'},
161 q^default_language/.{2}/en^, \$self->{'default_language'},
162 q^first/.*/^, \$self->{'first'},
163 q^extract_date^, \$self->{'date_extract'},
164 qq^maximum_date/\\d{4}/$year^, \$self->{'max_year'},
165 q^no_bibliography^, \$self->{'no_biblio'},
166 qq^maximum_century/-?\\d{1,2}( ?B\\.C\\.E\\.)?/-1^, \$self->{'max_century'},
167 "allow_extra_options")) {
168
169 print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
170 print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
171 &print_general_usage($plugin_name);
172 die "\n";
173 }
174
175 return bless $self, $class;
176}
177
178# initialize BasPlug options
179# if init() is overridden in a sub-class, remember to call BasPlug::init()
180sub init {
181 my $self = shift (@_);
182 my ($verbosity, $outhandle, $failhandle) = @_;
183
184 # verbosity is passed through from the processor
185 $self->{'verbosity'} = $verbosity;
186
187 # as are the outhandle and failhandle
188 $self->{'outhandle'} = $outhandle if defined $outhandle;
189 $self->{'failhandle'} = $failhandle;
190
191 # set process_exp and block_exp to defaults unless they were
192 # explicitly set
193
194 if ((!$self->is_recursive()) and
195 (!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
196
197 $self->{'process_exp'} = $self->get_default_process_exp ();
198 if ($self->{'process_exp'} eq "") {
199 warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
200 }
201 }
202
203 if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
204 $self->{'block_exp'} = $self->get_default_block_exp ();
205 }
206}
207
208sub begin {
209 my $self = shift (@_);
210 my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
211 $self->initialise_extractors();
212}
213
214sub end {
215 my ($self) = @_;
216 $self->finalise_extractors();
217}
218
219# this function should be overridden to return 1
220# in recursive plugins
221sub is_recursive {
222 my $self = shift (@_);
223
224 return 0;
225}
226
227sub get_default_block_exp {
228 my $self = shift (@_);
229
230 return "";
231}
232
233sub get_default_process_exp {
234 my $self = shift (@_);
235
236 return "";
237}
238
239# The BasPlug read() function. This function does all the right things
240# to make general options work for a given plugin. It calls the process()
241# function which does all the work specific to a plugin (like the old
242# read functions used to do). Most plugins should define their own
243# process() function and let this read() function keep control.
244#
245# recursive plugins (e.g. RecPlug) and specialized plugins like those
246# capable of processing many documents within a single file (e.g.
247# GMLPlug) should normally implement their own version of read()
248#
249# Return number of files processed, undef if can't process
250# Note that $base_dir might be "" and that $file might
251# include directories
252
253sub read {
254 my $self = shift (@_);
255
256 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
257
258 if ($self->is_recursive()) {
259 die "BasPlug::read function must be implemented in sub-class for recursive plugins\n";
260 }
261
262 my $outhandle = $self->{'outhandle'};
263
264 my $filename = $file;
265 $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
266
267 if ($self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/) {
268 $self->{'num_blocked'} ++;
269 return 0;
270 }
271 if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
272 return undef;
273 }
274 my $plugin_name = ref ($self);
275 $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
276
277 my ($language, $encoding);
278 if ($self->{'input_encoding'} eq "auto") {
279 # use textcat to automatically work out the input encoding and language
280 ($language, $encoding) = $self->get_language_encoding ($filename);
281
282 } elsif ($self->{'extract_language'}) {
283 # use textcat to get language metadata
284 ($language, $extracted_encoding) = $self->get_language_encoding ($filename);
285 $encoding = $self->{'input_encoding'};
286
287 if ($extracted_encoding ne $encoding && $self->{'verbosity'}) {
288 print $outhandle "$plugin_name: WARNING: $file was read using $encoding encoding but ";
289 print $outhandle "appears to be encoded as $extracted_encoding.\n";
290 }
291
292 } else {
293 $language = $self->{'default_language'};
294 $encoding = $self->{'input_encoding'};
295 }
296
297 # create a new document
298 my $doc_obj = new doc ($filename, "indexed_doc");
299 $doc_obj->set_OIDtype ($processor->{'OIDtype'});
300 $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Language", $language);
301 $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Encoding", $encoding);
302 $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($file));
303
304 # read in file ($text will be in utf8)
305 my $text = "";
306 $self->read_file ($filename, $encoding, $language, \$text);
307
308 if (!length ($text)) {
309 print $outhandle "$plugin_name: ERROR: $file contains no text\n" if $self->{'verbosity'};
310
311 my $failhandle = $self->{'failhandle'};
312 print $failhandle "$file: " . ref($self) . ": file contains no text\n";
313 $self->{'num_not_processed'} ++;
314
315 return 0;
316 }
317
318 # include any metadata passed in from previous plugins
319 # note that this metadata is associated with the top level section
320 $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
321
322 # do plugin specific processing of doc_obj
323 return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
324
325 # do any automatic metadata extraction
326 $self->auto_extract_metadata ($doc_obj);
327
328 # add an OID
329 $doc_obj->set_OID();
330
331 # process the document
332 $processor->process($doc_obj);
333
334 $self->{'num_processed'} ++;
335
336 return 1; # processed the file
337}
338
339# returns undef if file is rejected by the plugin
340sub process {
341 my $self = shift (@_);
342 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
343
344 die "Basplug::process function must be implemented in sub-class\n";
345
346 return undef; # never gets here
347}
348
349# uses the multiread package to read in the entire file pointed to
350# by filename and loads the resulting text into $$textref. Input text
351# may be in any of the encodings handled by multiread, output text
352# will be in utf8
353sub read_file {
354 my $self = shift (@_);
355 my ($filename, $encoding, $language, $textref) = @_;
356
357 if (!-r $filename)
358 {
359 my $outhandle = $self->{'outhandle'};
360 print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
361 return;
362 }
363
364 $$textref = "";
365
366 open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
367
368 if ($encoding eq "ascii") {
369 undef $/;
370 $$textref = <FILE>;
371 $/ = "\n";
372 } else {
373 my $reader = new multiread();
374 $reader->set_handle ('BasPlug::FILE');
375 $reader->set_encoding ($encoding);
376 $reader->read_file ($textref);
377
378 if ($language eq "zh") {
379 # segment the Chinese words
380 $$textref = &cnseg::segment($$textref);
381 }
382 }
383
384 close FILE;
385}
386
387# Uses textcat to work out the encoding and language of the text in
388# $filename. All html tags are removed before processing.
389# returns an array containing "language" and "encoding"
390sub get_language_encoding {
391 my $self = shift (@_);
392 my ($filename) = @_;
393 my $outhandle = $self->{'outhandle'};
394
395 # read in file
396 open (FILE, $filename) || die "BasPlug::get_language_encoding could not open $filename for reading ($!)\n";
397 undef $/;
398 my $text = <FILE>;
399 $/ = "\n";
400 close FILE;
401
402 # remove <title>stuff</title> -- as titles tend often to be in English
403 # for foreign language documents
404 $text =~ s/<title>.*?<\/title>//i;
405
406 # remove all HTML tags
407 $text =~ s/<[^>]*>//sg;
408
409 # get the language/encoding
410 my $results = $self->{'textcat'}->classify(\$text);
411
412 # if textcat returns 3 or less possibilities we'll use the
413 # first one in the list - otherwise use the defaults
414 if (scalar @$results > 3) {
415
416 if ($self->{'input_encoding'} ne 'auto') {
417 if ($self->{'extract_language'} && $self->{'verbosity'}) {
418 print $outhandle "BasPlug: WARNING: language could not be extracted from $filename - ";
419 print $outhandle "defaulting to $self->{'default_language'}\n";
420 }
421 return ($self->{'default_language'}, $self->{'input_encoding'});
422
423 } else {
424 if ($self->{'verbosity'}) {
425 print $outhandle "BASPlug: WARNING: language/encoding could not be extracted from $filename - ";
426 print $outhandle "defaulting to $self->{'default_language'}/$self->{'default_encoding'}\n";
427 }
428 return ($self->{'default_language'}, $self->{'default_encoding'});
429 }
430 }
431
432 # format language/encoding
433 my ($language, $encoding) = $results->[0] =~ /^([^-]*)(?:-(.*))?$/;
434 if (!defined $language) {
435 if ($self->{'verbosity'}) {
436 print $outhandle "BasPlug: WARNING: language could not be extracted from $filename - ";
437 print $outhandle "defaulting to $self->{'default_language'}\n";
438 }
439 $language = $self->{'default_language'};
440 }
441 if (!defined $encoding) {
442 if ($self->{'verbosity'}) {
443 print $outhandle "BasPlug: WARNING: encoding could not be extracted from $filename - ";
444 print $outhandle "defaulting to $self->{'default_encoding'}\n";
445 }
446 $encoding = $self->{'default_encoding'};
447 }
448
449 if ($encoding !~ /^(ascii|utf8|unicode)$/ &&
450 !defined $encodings::encodings->{$encoding}) {
451 if ($self->{'verbosity'}) {
452 print $outhandle "BasPlug: WARNING: $filename appears to be encoded in an unsupported encoding ($encoding) - ";
453 print $outhandle "using $self->{'default_encoding'}\n";
454 }
455 $encoding = $self->{'default_encoding'};
456 }
457
458 return ($language, $encoding);
459}
460
461# add any extra metadata that's been passed around from one
462# plugin to another.
463# extra_metadata uses add_utf8_metadata so it expects metadata values
464# to already be in utf8
465sub extra_metadata {
466 my $self = shift (@_);
467 my ($doc_obj, $cursection, $metadata) = @_;
468
469 foreach my $field (keys(%$metadata)) {
470 # $metadata->{$field} may be an array reference
471 if (ref ($metadata->{$field}) eq "ARRAY") {
472 map {
473 $doc_obj->add_utf8_metadata ($cursection, $field, $_);
474 } @{$metadata->{$field}};
475 } else {
476 $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field});
477 }
478 }
479}
480
481# initialise metadata extractors
482sub initialise_extractors {
483 my $self = shift (@_);
484
485 if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
486 &acronym::initialise_acronyms();
487 }
488}
489
490# finalise metadata extractors
491sub finalise_extractors {
492 my $self = shift (@_);
493
494 if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
495 &acronym::finalise_acronyms();
496 }
497}
498
499# FIRSTNNN: extract the first NNN characters as metadata
500sub extract_first_NNNN_characters {
501 my $self = shift (@_);
502 my ($textref, $doc_obj, $thissection) = @_;
503
504 foreach my $size (split /,/, $self->{'first'}) {
505 my $tmptext = $$textref;
506 $tmptext =~ s/^\s+//;
507 $tmptext =~ s/\s+$//;
508 $tmptext =~ s/\s+/ /gs;
509 $tmptext = substr ($tmptext, 0, $size);
510 $tmptext =~ s/\s\S*$/&#8230;/;
511 $doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
512 }
513}
514
515sub extract_email {
516 my $self = shift (@_);
517 my ($textref, $doc_obj, $thissection) = @_;
518 my $outhandle = $self->{'outhandle'};
519
520 print $outhandle " extracting email addresses ...\n"
521 if ($self->{'verbosity'} > 2);
522
523 my @email = ($$textref =~ m/([-a-z0-9\.@+_=]+@(?:[-a-z0-9]+\.)+(?:com|org|edu|mil|int|net|[a-z][a-z]))/g);
524 @email = sort @email;
525
526 my @email2 = ();
527 foreach my $address (@email) {
528 if (!(join(" ",@email2) =~ m/$address/ )) {
529 push @email2, $address;
530 $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
531 print $outhandle " extracting $address\n"
532 if ($self->{'verbosity'} > 3);
533 }
534 }
535 print $outhandle " done extracting email addresses.\n"
536 if ($self->{'verbosity'} > 2);
537
538}
539
540# extract metadata
541sub auto_extract_metadata {
542
543
544 my $self = shift (@_);
545 my ($doc_obj) = @_;
546
547 if ($self->{'extract_email'}) {
548 my $thissection = $doc_obj->get_top_section();
549 while (defined $thissection) {
550 my $text = $doc_obj->get_text($thissection);
551 $self->extract_email (\$text, $doc_obj, $thissection) if $text =~ /./;
552 $thissection = $doc_obj->get_next_section ($thissection);
553 }
554 }
555
556
557#adding kea keyphrases
558 if ($self->{'kea'}) {
559
560 my $thissection = $doc_obj->get_top_section();
561 my $text = "";
562 my @list;
563
564 while (defined $thissection) { #loop through sections to gather whole doc
565 my $sectiontext = $doc_obj->get_text($thissection);
566 $text = $text.$sectiontext;
567 $thissection = $doc_obj->get_next_section ($thissection);
568 }
569
570 if($self->{'kea_options'}) { #if kea options flag is set, call Kea with specified options
571 @list = &Kea::extract_KeyPhrases ($text, $self->{'kea_options'});
572 } else { #otherwise call Kea with no options
573 @list = &Kea::extract_KeyPhrases ($text);
574 }
575
576 if(@list){ #if a list of kea keyphrases was returned (ie not empty)
577 my $keyphrases = $list[0]; #first arg is keyphrase list
578 my $stems = $list[1]; #second arg is stemmed keyphrase list
579 print STDERR "keyphrases: $keyphrases\n";
580 print STDERR "stems: $stems\n";
581 $thissection = $doc_obj->get_top_section(); #add metadata to top section
582 $doc_obj->add_metadata($thissection, "kea", $keyphrases);
583 $doc_obj->add_metadata($thissection, "stems", $stems);
584 }
585 } #end of kea
586
587 if ($self->{'first'}) {
588 my $thissection = $doc_obj->get_top_section();
589 while (defined $thissection) {
590 my $text = $doc_obj->get_text($thissection);
591 $self->extract_first_NNNN_characters (\$text, $doc_obj, $thissection) if $text =~ /./;
592 $thissection = $doc_obj->get_next_section ($thissection);
593 }
594 }
595
596 if ($self->{'extract_acronyms'}) {
597 my $thissection = $doc_obj->get_top_section();
598 while (defined $thissection) {
599 my $text = $doc_obj->get_text($thissection);
600 $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
601 $thissection = $doc_obj->get_next_section ($thissection);
602 }
603 }
604
605 if ($self->{'markup_acronyms'}) {
606 my $thissection = $doc_obj->get_top_section();
607 while (defined $thissection) {
608 my $text = $doc_obj->get_text($thissection);
609 $text = $self->markup_acronyms ($text, $doc_obj, $thissection);
610 $doc_obj->delete_text($thissection);
611 $doc_obj->add_text($thissection, $text);
612 $thissection = $doc_obj->get_next_section ($thissection);
613 }
614 }
615
616 if($self->{'date_extract'}) {
617 my $thissection = $doc_obj->get_top_section();
618 while (defined $thissection) {
619
620 my $text = $doc_obj->get_text($thissection);
621 &DateExtract::get_date_metadata($text, $doc_obj,
622 $thissection,
623 $self->{'no_biblio'},
624 $self->{'max_year'},
625 $self->{'max_century'});
626 $thissection = $doc_obj->get_next_section ($thissection);
627 }
628 }
629}
630
631# extract acronyms from a section in a document. progress is
632# reported to outhandle based on the verbosity. both the Acronym
633# and the AcronymKWIC metadata items are created.
634
635sub extract_acronyms {
636 my $self = shift (@_);
637 my ($textref, $doc_obj, $thissection) = @_;
638 my $outhandle = $self->{'outhandle'};
639
640 print $outhandle " extracting acronyms ...\n"
641 if ($self->{'verbosity'} > 2);
642
643 my $acro_array = &acronym::acronyms($textref);
644
645 foreach my $acro (@$acro_array) {
646
647 #check that this is the first time ...
648 my $seen_before = "false";
649 my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
650 foreach my $thisAcro (@$previous_data) {
651 if ($thisAcro eq $acro->to_string()) {
652 $seen_before = "true";
653 print $outhandle " already seen ". $acro->to_string() . "\n"
654 if ($self->{'verbosity'} >= 4);
655 }
656 }
657
658 if ($seen_before eq "false") {
659 #write it to the file ...
660 $acro->write_to_file();
661
662 #do the normal acronym
663 $doc_obj->add_utf8_metadata($thissection, "Acronym", $acro->to_string());
664 print $outhandle " adding ". $acro->to_string() . "\n"
665 if ($self->{'verbosity'} > 3);
666
667 }
668 }
669 print $outhandle " done extracting acronyms. \n"
670 if ($self->{'verbosity'} > 2);
671}
672
673sub markup_acronyms {
674 my $self = shift (@_);
675 my ($text, $doc_obj, $thissection) = @_;
676 my $outhandle = $self->{'outhandle'};
677
678 print $outhandle " marking up acronyms ...\n"
679 if ($self->{'verbosity'} > 2);
680
681 #self is passed in to check for verbosity ...
682 $text = &acronym::markup_acronyms($text, $self);
683
684 print $outhandle " done marking up acronyms. \n"
685 if ($self->{'verbosity'} > 2);
686
687 return $text;
688}
689
690sub compile_stats {
691 my $self = shift(@_);
692 my ($stats) = @_;
693
694 $stats->{'num_processed'} += $self->{'num_processed'};
695 $stats->{'num_not_processed'} += $self->{'num_not_processed'};
696
697}
698
6991;
Note: See TracBrowser for help on using the repository browser.