root/main/trunk/greenstone2/perllib/plugins/GISExtractor.pm @ 22597

Revision 18752, 11.4 KB (checked in by kjdon, 11 years ago)

added a self param to loadGISDatabase, some indentation

  • Property svn:keywords set to Author Date Id Revision
Line 
1###########################################################################
2#
3# GISExtractor.pm -- extension base class to enhance plugins with GIS capabilities
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 GISExtractor;
27
28use PrintInfo;
29
30use util;
31
32use gsprintf 'gsprintf';
33use strict;
34no strict 'refs'; # allow filehandles to be variables and viceversa
35no strict 'subs';
36
37#field categories in DataBase files
38#$LAT = 3;
39#$LONG = 4;
40my $FC = 9;
41my $DSG = 10;
42#$CC1 = 12;
43my $FULL_NAME = 22;
44
45BEGIN {
46    @GISExtractor::ISA = ('PrintInfo');
47}
48
49
50my $arguments =
51    [ { 'name' => "extract_placenames",
52    'desc' => "{GISExtractor.extract_placenames}",
53    'type' => "flag",
54    'reqd' => "no" },
55      { 'name' => "gazetteer",
56    'desc' => "{GISExtractor.gazetteer}",
57    'type' => "string",
58    'reqd' => "no" },
59      { 'name' => "place_list",
60    'desc' => "{GISExtractor.place_list}",
61    'type' => "flag",
62    'reqd' => "no" } ];
63
64
65my $options = { 'name'     => "GISExtractor",
66        'desc'     => "{GISExtractor.desc}",
67        'abstract' => "yes",
68        'inherits' => "yes",
69        'args' => $arguments };
70
71
72sub new {
73    my ($class) = shift (@_);
74    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
75    push(@$pluginlist, $class);
76
77    # can we indicate that these are not available if the map data is not there??
78    #if (has_mapdata()) {
79    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
80    push(@{$hashArgOptLists->{"OptList"}},$options);
81    #}
82
83    my $self = new PrintInfo($pluginlist, $inputargs, $hashArgOptLists, 1);
84
85    return bless $self, $class;
86
87}
88
89sub initialise_gis_extractor {
90    my $self = shift (@_);
91
92    if ($self->{'extract_placenames'}) {
93   
94    my $outhandle = $self->{'outhandle'};
95   
96    my $places_ref
97        = $self->loadGISDatabase($outhandle,$self->{'gazetteer'});
98   
99    if (!defined $places_ref) {
100        print $outhandle "Warning: Error loading mapdata gazetteer \"$self->{'gazetteer'}\"\n";
101        print $outhandle "         No placename extraction will take place.\n";
102        $self->{'extract_placenames'} = undef;
103    }
104    else {
105        $self->{'places'} = $places_ref;
106    }
107    }
108   
109   
110}
111
112sub extract_gis_metadata
113{
114    my $self = shift (@_);
115    my ($doc_obj) = @_;
116   
117    if ($self->{'extract_placenames'}) {
118    my $thissection = $doc_obj->get_top_section();
119    while (defined $thissection) {
120        my $text = $doc_obj->get_text($thissection);
121        $self->extract_placenames (\$text, $doc_obj, $thissection) if $text =~ /./;
122        $thissection = $doc_obj->get_next_section ($thissection);
123    }
124    }
125
126}
127
128sub has_mapdata
129{
130    my $db_dir = &util::filename_cat($ENV{'GSDLHOME'}, "lamp", "data");
131    return ( -d $db_dir );
132}
133
134
135#returns a hash table of names from database files (specified in collect.cfg).
136sub loadGISDatabase {
137    my $self = shift (@_);
138    my ($outhandle,$datasets) = @_;
139    my @dbase = map{$_ = $_ . ".txt";} split(/,/, $datasets);
140    if(scalar(@dbase)==0) { #default is to include all databases
141    @dbase=("UK.txt", "NZ.txt", "NF.txt", "CA.txt", "AS.txt", "GM.txt", "BE.txt", "IN.txt", "JA.txt", "USA.txt");
142    }
143    my $counter=0;
144    my %places = ();
145    my @cats = (); 
146    while($counter <= $#dbase){ #loop through all the databases
147    my $folder = $dbase[$counter];
148    $folder =~ s/(.*?)\.txt/$1/;
149####        my $dbName = &util::filename_cat($ENV{'GSDLHOME'}, "etc", "mapdata", "data", $folder, $dbase[$counter]);
150    my $dbName = &util::filename_cat($ENV{'GSDLHOME'}, "lamp", "data", $folder, $dbase[$counter]);
151    if (!open(FILEIN, "<$dbName")) {
152        print $outhandle "Unable to open database $dbName: $!\n";
153        return undef;
154    }
155   
156    my $line = <FILEIN>; #database category details.
157    my @catdetails = split("\t", $line);
158   
159    while ( defined($line = <FILEIN>)){ #stores all place names in file as keys in hash array %places
160        @cats = split("\t", $line);
161        if( #eliminating "bad" place names without missing real ones
162        ($cats[$FC] eq "A" && !($cats[$DSG] =~ /ADMD|ADM2|PRSH/))
163        ||($cats[$FC] eq "P" && ($cats[$DSG] =~ /PPLA|PPLC|PPLS/))
164        ||($cats[$FC] eq "H" && ($cats[$DSG] =~ /BAY|LK/))
165        ||($cats[$FC] eq "L" && !($cats[$DSG] =~ /LCTY|RGN/))
166        ||($cats[$FC] eq "T" && ($cats[$DSG] =~ /CAPE|ISL|GRGE/))
167        ||($dbase[$counter] eq "USA.txt" && ($cats[$DSG] =~ /ppl|island/))
168        ){$places{$cats[$FULL_NAME]} = [@cats];}
169            @cats = ();
170    }   
171    close(FILEIN);
172    $counter++;
173    }   
174    return \%places;
175}
176
177#returns a unique hash array of all the places found in a document, along with coordinates, description and country data
178sub getPlaces {
179    my $self = shift @_;
180
181    my ($textref, $places) = @_;
182    my %tempPlaces = ();   
183   
184    foreach my $plc (%$places){ #search for an occurrence of each place in the text
185        if($$textref =~ m/(\W)$plc(\W)/){
186            $tempPlaces{$plc} = $places->{$plc};
187        }
188    }
189    #make sure each place is only there once
190    my %uniquePlaces = ();
191    foreach my $p (keys %tempPlaces) { 
192        if(!defined($uniquePlaces{$p})){
193            $uniquePlaces{$p} = $tempPlaces{$p};
194        }
195    }
196    return \%uniquePlaces;
197}
198
199
200
201
202#returns a lowercase version of the place, with no spaces
203sub placename_to_anchorname {
204    my $self = shift (@_);
205    my ($placename) = @_;
206    my $p_tag = lc($placename);
207    $p_tag =~ s/\s+//g;
208    return $p_tag;
209}
210
211#takes a place from the text and wraps an anchor tag, a hyperlink tag and an image tag around it
212sub anchor_wrapper {
213    my ($p, $p_counter_ref, $path) = @_;
214    my $image = "/gsdlgis/gisimages/nextplace.gif";
215    my $endTag = "</a>";
216    my $hrefTag = "<a href=";
217    $$p_counter_ref++;
218    my $next = $$p_counter_ref + 1;
219    my $p_tag = placename_to_anchorname($p);
220    my $place_anchor = "<a name=\"" . $p_tag . $$p_counter_ref . "\">" . $endTag;
221    my $popup_anchor = $hrefTag . "'" . $path . "'>" . $p . $endTag;
222    my $image_anchor = $hrefTag . "#" . $p_tag . $next . "><img src=\"" . $image . "\" name=\"img" . $p_tag . $$p_counter_ref . "\" border=\"0\">" . $endTag;
223    return $place_anchor . $popup_anchor . $image_anchor;
224}
225
226#takes dangerous place names and checks if they are part of another placename or not.
227sub place_name_check {
228    my ($pre, $preSpace, $p, $postSpace, $post, $p_counter_ref, $path, $y) = @_;
229    if($pre =~ /$y/ || $post =~ /$y/) {return $pre . $preSpace . $p . $postSpace . $post;}
230    $pre = $pre . $preSpace;
231    $post = $postSpace . $post;
232    return $pre . &anchor_wrapper("", $p, "", $p_counter_ref, $path) . $post;
233}
234
235sub extract_placenames {
236    my $self = shift (@_);
237    my ($textref, $doc_obj, $thissection) = @_;
238    my $outhandle = $self->{'outhandle'};
239
240    my $GSDLHOME = $ENV{'GSDLHOME'};
241    #field categories in DataBase file for extract_placenames.
242    my $LAT = 3;
243    my $LONG = 4;
244    my $CC1 = 12;
245
246   
247    &gsprintf($outhandle, " {GISExtractor.extracting_placenames}...\n")
248    if ($self->{'verbosity'} > 2);
249
250    #get all the places found in the document   
251    my $uniquePlaces = $self->getPlaces($textref, $self->{'places'});
252       
253    #finds 'dangerous' placenames (eg York and New York). Dangerous because program will find "York" within "New York" 
254    my %danger = ();   
255    foreach my $x (keys %$uniquePlaces){
256    foreach my $y (keys %$uniquePlaces){
257        if(($y =~ m/ /) && ($y =~ m/$x/) && ($y ne $x)){
258            $y =~ s/($x\s)|(\s$x)//;
259            $danger{$x} = $y;
260        }
261    }
262    } 
263     
264    #creates a list of clickable placenames at top of page, linked to first occurrence of name, and reads them into a file
265    my $tempfname = $doc_obj;
266    $tempfname =~ s/.*\(0x(.*)\)/$1/;
267    my $names = "";
268    my $filename = "tmpfile" . $tempfname;
269    my $tempfile = &util::filename_cat($GSDLHOME, "tmp", $filename);
270    open(FOUT, ">$tempfile") || die "Unable to create a temp file: $!";
271    foreach my $name (sort (keys %$uniquePlaces)){
272    if(!defined($danger{$name})){
273        my $name_tag = placename_to_anchorname($name);
274        print FOUT "$name\t" . $uniquePlaces->{$name}->[$LONG] . "\t" . $uniquePlaces->{$name}->[$LAT] . "\n";
275        if($self->{'place_list'}) {$names = $names . "<a href=\"#" . $name_tag . "1\">" . $name . "</a>" . "\n";}
276    }
277    }
278    close(FOUT);
279    $doc_obj->associate_file($tempfile, "places.txt", "text/plain");
280    $self->{'places_filename'} = $tempfile;
281   
282    my %countries = ();
283   
284    foreach my $p (keys %$uniquePlaces){
285    my $place = $p;
286    $place =~ s/\s+|\n+|\r+|\t+/(\\s+)/g;
287    my $cap_place = uc($place);
288    my $long = $uniquePlaces->{$p}->[$LONG];
289    my $lat = $uniquePlaces->{$p}->[$LAT];
290    my $country = $uniquePlaces->{$p}->[$CC1];
291    my $path = "javascript:popUp(\"$long\",\"$lat\",\"$p\",\"$country\")";
292    my $p_counter = 0;
293   
294    if(!defined($danger{$p})){ 
295        #adds html tags to each place name
296        $$textref =~ s/\b($place|$cap_place)\b/&anchor_wrapper($1,\$p_counter,$path)/sge;
297    }
298    #else {
299    #$y = $danger{$p};
300    #$$textref =~ s/(\w+)(\s+?)($place|$cap_place)(\s+?)(\w+)/&place_name_check($1,$2,$3,$4,$5,\$p_counter,$path, $y)/sge; 
301    #}
302   
303    #edits the last place's image, and removes image if place only occurres once.
304    my $p_tag = placename_to_anchorname($p);
305    $p_counter++;
306    $$textref =~ s/#$p_tag$p_counter(><img src="\/gsdl\/images\/)nextplace.gif/#${p_tag}1$1firstplace.gif/;
307    $$textref =~ s/<img src="\/gsdl\/images\/firstplace.gif" name="img$p_tag(1)" border="0">//;
308   
309    #this line removes apostrophes from placenames (they break the javascript function)
310    $$textref =~ s/(javascript:popUp.*?)(\w)'(\w)/$1$2$3/g; #' (to get emacs colours back)
311       
312    #for displaying map of document, count num of places from each country
313    if(defined($countries{$country})){$countries{$country}++;}
314    else{$countries{$country} = 1;}
315
316    #adds placename to metadata
317    $doc_obj->add_utf8_metadata ($thissection, "Placename", $p);   
318    &gsprintf($outhandle, "  {AutoExtractMetadata.extracting} $p\n")
319        if ($self->{'verbosity'} > 3);
320    }
321    #finding the country that most places are from, in order to display map of the document
322    my $max = 0;
323    my $CNTRY = "";
324    foreach my $c_key (keys %countries){
325    if($countries{$c_key} > $max){
326        $max = $countries{$c_key};
327        $CNTRY = $c_key;
328    }
329    }
330    #allows user to view map with all places from the document on it
331####    my $places_filename = &util::filename_cat($GSDLHOME, "collect", "_cgiargc_", "index", "assoc", "_thisOID_", "places.txt");
332    my $places_filename = &util::filename_cat("collect", "_cgiargc_", "index", "assoc", "_thisOID_", "places.txt");
333    my $docmap = "<a href='javascript:popUp(\"$CNTRY\",\"$places_filename\")'>View map for this document<\/a><br><br>\n";
334    $$textref = $docmap . $names . "<br>" . $$textref;
335   
336    $doc_obj->delete_text($thissection);
337    $doc_obj->add_utf8_text($thissection, $$textref);
338    &gsprintf($outhandle, " {GISExtractor.done_places_extract}\n")
339    if ($self->{'verbosity'} > 2);
340}
341
342sub clean_up_temp_files {
343    my $self = shift(@_);
344   
345    if(defined($self->{'places_filename'}) && -e $self->{'places_filename'}){
346    &util::rm($self->{'places_filename'});
347    }
348    $self->{'places_filename'} = undef;
349
350}
Note: See TracBrowser for help on using the browser.