package Image::Maps::Plot::FromLatLong; # where in the world are London.pm members? our $VERSION = 0.12; our $DATE = "Thu 17 November 18:50 2004"; use 5.006; use strict; use warnings; use Image::Magick; use File::Basename; use Data::Dumper; use Config; =head1 NAME Image::Maps::Plot::FromLatLong - plots points on Mercator Projection world/regional map =head1 SYNOPSIS use Image::Maps::Plot::FromLatLong; # Get ready $m = new Image::Maps::Plot::FromLatLong ( MAP=>"THE WORLD", PATH=>"C:/out.html", # Extension is irrelevant FONT=>"C:/winnt/fonts/arial.ttf", ); # Now, Create an HTML page with images: $m->create_html; # Or just the image $m->create_imagefile; # Or get a reference to an image blob: $m->get_blob; # Create HTML pages of all maps in the db, with index my $m = new Image::Maps::Plot::FromLatLong( FONT=>'c:/winnt/fonts/arial.ttf', ); $m->all("C:/"); # Add a map $Image::Maps::Plot::FromLatLong::MAPS{"LONDON AREA"} = { FILE => 'C:\PhotoWebServer\Perl\site\lib\Image\Maps\Plot\london_bourghs.jpg', DIM => [650,640], SPOTSIZE => 5, ANCHOR_PIXELS => [447,397], # Greenwich on the pixel map ANCHOR_LATLON => [51.466,0], # Greenwich lat/lon ANCHOR_NAME => 'Greenwich', ANCHOR_PLACE => 'Observatory', ONEMILE => 19.5, # 1 km = .6 miles (10km=180px = 10miles=108px) }; # Add a user to the db $m->load_db (".earth.dat"); $m->add_entry ('Ike Elben Goddard','Hungary','H-1165'); $m->save_db (".aliyah.dat"); # Create map content on the fly: $maker = new Image::Maps::Plot::FromLatLong( MAP => "THE WORLD", FONT=>'c:/winnt/fonts/arial.ttf', PATH => "/Two.foo", DBFILE => undef, LOCATIONS => { 'Lee' => { 'LAT' => '51.592423', 'PLACE' => '#ffff44', 'LON' => '-0.171996' }, 'Lee Again' => { 'PLACE' => '#ffff77', 'LAT' => 46, 'LON' => 16 }, }, ); __END__ =head1 DESCRIPTION Plots points defined by latitude/longitude on JPEG Mercator Projection maps, optionally creating an HTML page with image map to display the image. =head1 PREREQUISITES Data::Dumper; File::Basename; strict; warnings. WWW::MapBlast 0.02 Image::Thumbnail 0.011 =head1 DISTRIBUTION CONTENTS In addition to this file, the distribution uses the included files for default settings: they should be placed in the same directory as the module itself only if you wish to use default settings. .earth.dat london_postcodes.jpg uk.jpg world.jpg =head1 EXPORTS None. =cut # # Global scalars # # Real-time output of what's going on; affecting by L<"new">. our $ADDENTRY = 'MULTIPLE'; # Cf. L<"add_entry"> our %locations = (); # Cf. L<"load_db"> # # See L and sub _make_latlon # our @LAT; our @_LAT = ( 68.70, 68.71, 68.73, 68.75, 68.79, 68.83, 68.88, 68.94, 68.99, 69.05, 69.12, 69.18, 69.23, 69.28, 69.32, 69.36, 69.39, 69.40, 69.41 ); our @LON; our @_LON = ( 69.17, 68.91, 68.13, 66.83, 65.03, 62.73, 59.96, 56.73, 53.06, 49.00, 44.55, 39.77, 34.67, 29.32, 23.73, 17.96, 12.05, 6.05, 0.00, ); &_make_latlon; # # Hack hack: prefix to locate our install dir # #my $MOD = "$Config{installsitelib}/".__PACKAGE__; #$MOD =~ s/::/\//g; #$MOD =~ s/[^\/]+$//; # MARKSTOS -at- CPAN -dot- org suggested: # I've not had a chance to test if this will burp # on relative paths/under mod_perl.... my $MOD = __PACKAGE__; $MOD =~ s/::/\//g; $MOD = $INC{$MOD.".pm"} || ''; $MOD =~ s/\.pm$//i; # # Default maps: see L<"ADDING MAPS"> to ... add maps. # our %MAPS = ( "THE WORLD" => { FILE => $MOD."world.jpg", DIM => [823,485], SPOTSIZE => 2, ANCHOR_PIXELS => [389,258], # Zero lat, zero lon ANCHOR_LATLON => [0,0], # 0,0 ANCHOR_NAME => '', ANCHOR_PLACE => 'Zero degrees latitude, zero degree longitude', ONEMILE => 0.0342, # was 0.0056, better with 0.0348 }, "THE UK" => { FILE => $MOD."uk.jpg", DIM => [363,447], SPOTSIZE => 4, ANCHOR_PIXELS => [305,388], # Greenwich ANCHOR_LATLON => [51.466,0], ANCHOR_NAME => 'Greenwich', ANCHOR_PLACE => 'Observatory', # ONEMILE => 00.55, ONEMILE => 0.51, }, "A BAD MAP OF LONDON LONDON" => { FILE => $MOD."london_postcodes.jpg", DIM => [650,640], SPOTSIZE => 8, ANCHOR_PIXELS => [447,397], # Greenwich ANCHOR_LATLON => [51.466,0], # Greenwich ANCHOR_NAME => 'Greenwich', ANCHOR_PLACE => 'Observatory', ONEMILE => 19.5, # 1 km = .6 miles (10km=180px = 10miles=108px) }, ); =head1 CONSTRUCTOR new Returns an object in this class. Accepts arguments in a hash, where keys/values are as follows: =over 4 =item MAP Either C, C, C, or any other key to the C<%MAPS> hash defined elsewhere, and documented L. =item PATH The path at which to save - will use the filename you supply, but please include an extension, coz I'm lazy. You will receive a C<.jpg> and C<.html> file in return. =item DBFILE Name of the configuration/db file - defaults to C<.earth.dat>, which comes with the distribution: set to C if you do not wish to use the default (perhaps because you are using the C field to supply a 'database' - see the next item). =item LOCATIONS Optional: a reference to a hash that will add and replace items in the module's content 'database'. Format of the hash referred to should be: $LOCATIONS = { 'This key is a printable proper name' => { 'LAT' => 11111111, # Latitude value, or 11111111 if unknown 'PLACE' => 'An Image;:Magick Colour Name or printable descriptor of the location', 'LON' => 11111111 # Longitude value, or 11111111 if unknown }, If C fields are supplied as hex colour names (C<#> prefix) then their values will not be printed. Note that if you supply this field I supplying the C with a value of C, you will inherit the default location 'database'. =item IMG_URI_PREFIX If supplied, will be prefixed to the value of the C C attribute in HTML pages generated. =item CHAT Set if you want rabbit (Amos: that's London-speak for talk) to STDERR. =item CREATIONTXT Text output onto the image. Defaults to 'Created on by .'; =item TITLE Title text to include on the image (in bold) and as the content of the HTML page's C element: is appended with the name of the map. This defaults to C<London.pm>, where this module originates. =item FONT Font for the above: absolute path or something Image Magick can find. =item INCLUDEANCHOR Set if you wish the map's anchor point to be included in the output. =item FNPREFIX Filename prefix - added to the start of all files output except the db file. Default is C<m_>. =item KEYS2VALUES If set, will assume the 'place' sub-keys in C<locations> hash are colour values for spots printed. =item BORDER, FILL Border and fill colours: if not set, SPOTCOLOUR will set them both. =item CSS Formatted inline CSS to go within a C<STYLE type='text/css'> block in the header. =item EXTRA_HTML If defined, added at the end of the page. =back =cut sub new { my $class = shift; die "Please call with a package ID" if not defined $class; my %args; my $self = {}; bless $self,$class; # Take parameters and place in object slots/set as instance variables if (ref $_[0] eq 'HASH'){ %args = %{$_[0]} } elsif (not ref $_[0]){ %args = @_ } %locations = (); undef %locations; # Default instance variables $self->{HTML} = ''; # Will contain the HTML for the image and image map $self->{MAP} = "THE WORLD"; # Default map cf. our %MAPS $self->{CREATIONTXT} = "Created on ".(scalar localtime)." by ".__PACKAGE__; $self->{FNPREFIX} = 'm_'; $self->{DBFILE} = "$MOD/.earth.dat"; $self->{HTML} = undef; $self->{FILL} = "white"; $self->{BORDER} = "red"; $self->{SPOTCOLOUR} = "red"; $self->{IMG_URI_PREFIX} = ""; $self->{EXTRA_HTML} = ""; $self->{CSS} = " "; $self->{TITLE} = " "; # Overwrite default instance variables with user's values foreach (keys %args) { $self->{$_} = $args{$_} } $self->{BORDER} = $self->{SPOTCOLOUR} unless exists $self->{BORDER}; $self->{FILL} = $self->{SPOTCOLOUR} unless exists $self->{FILL}; # Legacy if ($self->{DBNAME}){ $self->{DBFILE} = $self->{DBNAME}; undef $self->{DBNAME}; delete $self->{DBNAME}; } $self->load_db($self->{DBFILE}) if $self->{DBFILE}; if ($self->{LOCATIONS}){ die "LOCATIONS must be a reference to a hash" if ref $self->{LOCATIONS} ne 'HASH'; foreach my $l (keys %{$self->{LOCATIONS}}){ $locations{$l} = $self->{LOCATIONS}->{$l}; } } if (not defined $self->{TITLE}){ $self->{TITLE} = $self->{MAP}; } return $self; } =head1 METHOD create_html Creates an image and an HTML page. Requires that the C<PATH> field be set (see L<CONSTRUCTOR>). =cut sub create_html { my $self=shift; die "Please supply an output path in your calling object\n" if not exists $self->{PATH}; my ($name,$path,$suffix) = fileparse($self->{PATH},'(\.[^.]*)?$' ); die "Please supply a filepath with a dummy extension" if not defined $name; $self->{PATH} = $path.$name; $self->{IMGPATH} = $name.'.jpg'; # Try to load the image into our object die "There is no option for a map of $self->{MAP}" if not exists $MAPS{$self->{MAP}}; if (not -e $MAPS{$self->{MAP}}->{FILE}){ warn "No map for $self->{MAP}: $!" ; return undef; } $self->_load_map or die "Could not read map from $MAPS{$self->{MAP}}->{FILE}:\nReason: $!\n "; # Now we have the argument for the map in question: $self->_add_html_top; $self->_add_map_top; $self->_populate(1); $self->_add_map_bottom; $self->_add_html_bottom; return $self->_save(1); } =head1 METHOD create_imagefile Creates just an image file. Requires that the C<PATH> field be set (see L<CONSTRUCTOR>). =cut sub create_imagefile { my $self=shift; die "Please supply an output path in your calling object \n" if not exists $self->{PATH}; my ($name,$path,$suffix) = fileparse($self->{PATH},'(\.[^.]*)?$' ); die "Please supply a filepath with a dummy extension" if not defined $name; $self->{PATH} = $path.$name; $self->{IMGPATH} = $name.'.jpg'; # Try to load the image into our object die "There is no option for a map of $self->{MAP}" if not exists $MAPS{$self->{MAP}}; if (not -e $MAPS{$self->{MAP}}->{FILE}){ warn "No map for $self->{MAP} at $MAPS{$self->{MAP}}->{FILE}: $!" ; return undef; } $self->_load_map or die "Could not read map from $MAPS{$self->{MAP}}->{FILE}: $!"; $self->_populate; return $self->_save; } =head1 METHOD create_blob Creates an image and return a reference to it's BLOB. Requires that the C<PATH> field be set (see L<CONSTRUCTOR>). =cut sub create_blob { my $self=shift; if ($self->{PATH}){ my ($name,$path,$suffix) = fileparse($self->{PATH},'(\.[^.]*)?$' ); $self->{PATH} = $path.$name; $self->{IMGPATH} = $name.'.jpg'; } # Try to load the image into our object if (not exists $MAPS{$self->{MAP}}){ warn "There is no option for a map of $self->{MAP}"; return undef; } if (not -e $MAPS{$self->{MAP}}->{FILE}){ warn "No map for $self->{MAP}: $!" ; return undef; } if (not $self->_load_map){ warn "Could not read map from $MAPS{$self->{MAP}}->{FILE}: $!"; return undef; } $self->_populate; return \$self->{IM}->ImageToBlob(); } # # Just loads the map specified in the FILE field of MAP array # field specified by the calling object's MAP field. # sub _load_map { my $self=shift; $self->{IM} = Image::Magick->new; my $err = $self->{IM}->Read($MAPS{$self->{MAP}}->{FILE}); warn "Load map error: $err ($!)" if $err; return $err? undef:1; } =head1 METHOD all (base_path,base_url,title, blurb) A method that produces all available maps, and an index page with thumbnails. It accepts four arguments, a path at which files can be built, a filename prefix (see L<"new">), a title, and blurb to add beneath the list of hyperlinks to the maps. If no base path is supplied, the C<PATH> field is used. An index page will be produced, linking to the following files for each map: =over 4 m_C<MAPNAME>.jpg m_C<MAPNAME>_t.jpg m_C<MAPNAME>.html =back where MAPNAME is ... the name of the map. The C<m_> prefix is held in the instance variable C<FNPREFIX>. You may also wish to look at and adjust the instance variable C<CREATIONTXT>. =cut sub all { my ($caller, $fpath,$fnprefix,$title,$blurb) = (@_); die "'all' is now a method!" if not ref $caller; $fpath = $caller->{PATH} unless $fpath; die "Please supply a PATH directory (first argument)" if not defined $fpath; die "No such directory as suppiled: $fpath" unless -d $fpath; if ($fpath !~ /(\/|\\)$/){$fpath.="/";} $fnprefix = '' if not defined $fnprefix; if (not defined $title) { $title = "London.pm"; } if (not defined $blurb) { $blurb = "These maps were created on ".(scalar localtime)." by ".__PACKAGE__; $blurb .=", available on <A href='http://search.cpan.org'>CPAN</A>, from data last updated on $DATE." ."<P>Maps originate either from the CIA (who placed them in the public domain), or unknown sources (defunct personal pages on the web)."."<BR><HR><P><SMALL>Copyright (C) <A href='mailto:lGoddard\@CPAN.Org'>Lee Goddard</A> 2001 - available under the same terms as Perl itself</SMALL></P>"; }; my $self = bless {}; $self->{HTML} = ''; $self->_add_html_top("$title Maps Index"); $self->{HTML} .= "<H1>$title Maps<HR></H1>\n"; foreach my $map (keys %MAPS){ $map =~ /(\w+)$/; die "Error making filename: didn't match regex" if not defined $1; $_ = __PACKAGE__; my $mapmaker = new (__PACKAGE__,{ MAP=>$map, PATH=>$fpath.$fnprefix.$1, FONT=>$caller->{FONT}, THUMB_SIZE => $caller->{THUMB_SIZE}, }); if ($mapmaker->create_html){ my ($tx,$ty) = $self->_create_thumbnail($fpath.$fnprefix.$1, $caller->{THUMB_SIZE}); $self->{HTML}.="<P><A href='$fnprefix$1.html'>"; $self->{HTML}.="<IMG alt='$1' src='" .($self->{IMG_URI_PREFIX}?$self->{IMG_URI_PREFIX}:"") ."$fnprefix$1_t.jpg' hspace='12' border='1' width='$tx' height='$ty'>"; $self->{HTML}.="$1"; $self->{HTML}.="</A></P>\n"; } } $self->{HTML}.="<P> </P>"; $self->{HTML}.=$blurb; $self->_add_html_bottom; open OUT,">$fpath$fnprefix"."index.html" or die "Couldn't open <$fpath$fnprefix"."index.html> for writing"; print OUT $self->{HTML}; close OUT; } # # Private method _save # # Saves the product of the module: saves HTML if eponymous field has content. # # Accepts a file path at which to save the JPEG and HTML output. # Supply a filename with any suffix: it will be ignored, and the JPEG image and HTML files will be given C<.jpg> and C<.html> # suffixes respectively. # sub _save { my $self = shift; die "Please call as a method." if not defined $self or not ref $self; local (*OUT); # Add text to image my $title = $self->{TITLE}; my @textlines = split /(by.*)$/,$self->{CREATIONTXT}; #my ($x,$y) = $self->{IM}->getBounds(); my ($x,$y) = ($self->{IM}->Get('columns'),$self->{IM}->Get('rows')); $x = 5; $y = 17; my $err = $self->{IM}->Annotate( font=>$self->{FONT} || 'Arial.ttf', pointsize=>10, fill=>$self->{FILL}, text=>@textlines ); warn $err if $err; # Save the JPEG warn "Going to save image for $self->{MAP} as $self->{PATH}.jpg...\n" if $self->{chat}; $err = $self->{IM}->Write($self->{PATH}.".jpg"); die "Could not save map as $self->{PATH}.jpg" if $err; warn "Saved image\n" if $self->{chat}; # Save the HTML if (defined $self->{HTML}){ warn "Going to save HTML as $self->{PATH}.html...\n" if $self->{chat}; open OUT, ">$self->{PATH}.html" or die "Could not save to <$self->{PATH}.html> "; print OUT $self->{HTML}; close OUT; warn "Saved HTML\n" if $self->{chat}; } warn "OK.\n" if $self->{chat}; return 1; } # _populate # # Populates the current map: adds HTML if passed an argument # sub _populate { my ($self,$add_html) = (shift,shift); die "Please call as a method." if not defined $self or not ref $self; warn "Populating the $self->{MAP} map.\n" if $self->{chat}; # Add the anchor point? if (exists $self->{INCLUDEANCHOR}){ my ($x,$y) = $self->_latlon_to_xy( $self->{MAP}, $MAPS{$self->{MAP}}->{ANCHOR_LATLON}[0], $MAPS{$self->{MAP}}->{ANCHOR_LATLON}[1] ); if (defined $x and defined $y){ $self->_add_to_map( $x,$y, $MAPS{$self->{MAP}}->{ANCHOR_NAME}, $MAPS{$self->{MAP}}->{ANCHOR_PLACE} ); } } foreach my $pusson (keys %locations){ warn "\tadding $pusson $locations{$pusson}->{PLACE}\n" if $self->{chat}; my ($x,$y) = $self->_latlon_to_xy( $self->{MAP},$locations{$pusson}->{LAT},$locations{$pusson}->{LON} ); if (defined $x and defined $y){ $self->_add_to_map( $x,$y, $pusson, $locations{$pusson}->{PLACE}||"-", $add_html ); } } } # # Private method: _add_to_map (x,yx,name,place) # # Adds to the current image and to the HTML being created # cf. $self->{IM}, $self->{HTML}. # # Accepts: x and y co-ordinates in the current map ($self->{MAP}) # name of entry # optionally, name of place # optional flag to create HTML for image map # sub _add_to_map { my ($self, $x,$y,$name,$place,$add_html) = (@_); # Add to the image die "Please call this METHOD with x,y, name,place!" if not defined $self or not defined $x or not defined $y or not defined $name; # Place is optional my $err; if ($x<0 or $x>$MAPS{$self->{MAP}}->{DIM}[0] or $y<0 or $y>$MAPS{$self->{MAP}}->{DIM}[1]){ warn "\t...out of the map bounds, not adding.\n" if $self->{chat}; return undef; } $name =~ s/'/\\'/g; $place =~ s/'/\\'/g; if (not exists $self->{FLOODFILL}){ $err = $self->{IM}->Draw( primitive=>'circle', x => ($x-($MAPS{$self->{MAP}}->{SPOTSIZE}/2)), y => ($y-($MAPS{$self->{MAP}}->{SPOTSIZE}/2)), bordercolor => $self->{BORDER}, fill => ($self->{KEYS2VALUES} ? ($place) : $self->{FILL} ), stroke => $self->{BORDER}, strokewidth => "1", antialias =>1, points=>$MAPS{$self->{MAP}}->{SPOTSIZE} ."," .$MAPS{$self->{MAP}}->{SPOTSIZE} ."," .$MAPS{$self->{MAP}}->{SPOTSIZE}, ); } else { $err = $self->{IM}->ColorFloodfill( x => ($x-($MAPS{$self->{MAP}}->{SPOTSIZE}/2)), y => ($y-($MAPS{$self->{MAP}}->{SPOTSIZE}/2)), fill => ($self->{KEYS2VALUES} ? ($place) : $self->{FILL} ), # bordercolor => ($self->{FLOODFILLBORDER}?$self->{FLOODFILLBORDER}:'#000000') ); } warn "Could not draw at $x,$y: $err ..." if $err and $self->{chat}; # Add to the HTML if ($add_html){ $self->{HTML} .= "<area " . "shape='circle' coords='" .($x+($MAPS{$self->{MAP}}->{SPOTSIZE}/2)) ."," .(1+$y+($MAPS{$self->{MAP}}->{SPOTSIZE}/2)) .",$MAPS{$self->{MAP}}->{SPOTSIZE}' " . "alt='" .($place!~/^#/? "$name ($place)" : $name) ."' title='$name"; $self->{HTML} .= " ($place)" if defined $place; $self->{HTML} .= "' href='javascript:alert(\"$name\\n" .($place!~/^#/? " ($place)" : "") ."\")' target='_self'>\n"; } warn "\t...adding to map at $x,$y\n" if $self->{chat}; } # # Private methods: _add_html_top, _add_map_top, _add_map_bottom, _add_html_bottom # # Call before adding elements to the map, to initiate up the HTML image map, and include the HTML iamge. # Optional second argument used as HTML TITLE element contents when no $self->{MAP} has been defined. # sub _add_html_top { my $self=shift; $self->{HTML} = "<html>\n<head>\n\t<title>" .($self->{TITLE}?$self->{TITLE}:"") ." "; if (exists $self->{CSS} and defined $self->{CSS}){ $self->{HTML} .= " "; } $self->{HTML}.="\n\n\n" .($self->{TITLE}?"

$self->{TITLE}

\n":""); } sub _add_map_top { my $self = shift; my ($x,$y) = ($self->{IM}->Get('columns'),$self->{IM}->Get('rows')); $self->{HTML} .="
\n" . "\n" . "\n\n"; } sub _add_map_bottom { my $self = shift; $self->{HTML} .= "\n\n
\n"; } sub _add_html_bottom { my $self = shift; $self->{HTML} .= "$self->{EXTRA_HTML}\n\n\n"; } # # METHOD: &_latlon_to_xy (map,latitude,longitude) # # Map latitude and longitude to pixel on $MAPS{$map} # # Accepts: name of map to map onto (key to our %MAPS) # latitude, longitude # Returns: the new co-ords on the map passed # # As it took me some time to get around this, # I've not optimized the code for fear. But hey, # at least you get to see my workings, as they # said in 'O' level Maths.... # sub _latlon_to_xy { my ($self,$map,$lat,$lon) = (@_); if ($lat>90) {warn "\t...can't add, incomplete/missing location details ($lat,$lon).\n" if $self->{chat}; return undef;} # Lat, Lon in miles my $m_lat = $lat - @{$MAPS{$map}->{ANCHOR_LATLON}}[0]; my $m_lon = $lon - @{$MAPS{$map}->{ANCHOR_LATLON}}[1]; $m_lat = $m_lat * $LAT[int $lat]; $m_lon = $m_lon * 69; # my $loni = int $lon; # $loni = -$loni if $loni<0; # if ($loni>90){ $loni = 90 - ($loni-90); } # $m_lon = $m_lon * ($LON[$loni]); # Invert to plot on map $m_lat = -$m_lat; my $px_lat = $m_lat * $MAPS{$map}->{ONEMILE}; my $px_lon = $m_lon * $MAPS{$map}->{ONEMILE}; # As zero degrees latitude is the equator, lat (y) is plotted # from the bottom of the image - this must be inverted! $px_lat += @{$MAPS{$map}->{ANCHOR_PIXELS}}[1]; $px_lon += @{$MAPS{$map}->{ANCHOR_PIXELS}}[0]; # Return in x,y order return (int $px_lon, int $px_lat); } =head1 METHOD load_db A method that loads a "database" hash from the specified path. Returns a true value on success, C on failure. =cut sub load_db { my ($self,$dbname) = (shift,shift); local *IN; warn "Loading DB from $dbname...\n" if $self->{chat}; if (not open IN, $dbname){ warn "Couldn't open the configuration file <$dbname> for reading"; return undef; } read IN, $_, -s IN; close IN; my $VAR1; # will come from evaluating the file produced by Data::Dumper. eval ($_); warn $@ if $@; %locations = %{$VAR1}; warn "OK.\n" if $self->{chat}; return 1; } =head1 METHOD save_db A method that saves the currently loaded "database" hash to the filename specified as the only arguemnt. Note tha tyou may want to load a db before saving. Returns nothing, but does C on failure. =cut # Simply uses C to dump the hash that stores the user values sub save_db { my ($self,$dbname) = (shift,shift); local *OUT; open OUT,">$dbname" or die "Couldn't open the configuration file <$dbname> for writing"; print OUT Dumper(\%locations); close OUT; } =head1 METHOD add_entry A method that accepts: $name, $latitude, $longitude, maybe $place_or_colour If an entry already exists for $name, will return C unless the global scalar C<$ADDENTRY> is set to it's default value of C, in which case $name will be appended with the time. Does not save them to file - you must do that manually (L<"METHOD save_db">), but note that you may wish to load the db before adding to it and saving. Incidentaly returns a reference to the new key. See also L. =cut sub add_entry { my ($self, $name, $lat,$lon,$place) = (@_); eval('use WWW::MapBlast 0.02;'); die "Can't add_entry without \$name, \$lat, \$lon, and maybe \$place_or_colour" unless (defined $name and defined $lat and defined $lon); $lat = 11111111 if not defined $lat or $lat eq ''; $lon = 11111111 if not defined $lon or $lon eq ''; if (not defined $place or $place eq ''){ $place = $name } if (exists $locations{$name} ){ if ($ADDENTRY ne 'MULTIPLE'){ warn "Not adding duplicate entry for $name at $lat, $lon.\n" if $self->{chat}; return undef; } $name .= " (".(scalar localtime).")"; # grep? } $locations{$name} = { PLACE=>$place, LAT=>$lat, LON=>$lon, }; return \$locations{$name}; } =head1 &remove_entry A subroutine, not a method, that accepts the name field of the entry in the db, and returns C<1> on success, C if no such entry exists. =cut sub remove_entry { my ($name) = (shift); return undef if not exists $locations{$name}; delete $locations{$name}; return 1; } # # METHOD _create_thumbnail (path to image, size of longest side) # Creates and saves a thumbnail of the specified image. # Returns the name of the image # sub _create_thumbnail { my ($self,$path,$size) = (shift,shift,shift); eval ("use Image::Thumbnail 0.011"); die $@ if $@; # Load your source image die "Passed no filepath to create_thumbnail " if not defined $path; $path .= '.jpg'; die "Passed bad filepath to create_thumbnail <$path>: $!" if not defined $path or not -e $path; $size = $self->{THUMB_SIZE} if not defined $size; $size = 75 if not defined $size; # Create the thumbnail from it, where the biggest side is 50 px my $outpath = $path; $outpath =~ s/\.jpg$/_t.jpg/; my $thumb = Image::Thumbnail->new( inputpath => $path, size => $size, outputpath => $outpath, CHAT => $self->{chat}, create => 1, ); return ($thumb->{x},$thumb->{y}); } # # Make @LAT and @LON to get length of a degree # sub _make_latlon { LAT:{ my $i = 0; foreach (@_LAT){ for my $j (0..4){ last LAT if $i+$j>90; $LAT[$i+$j] = $_; } $i += 5; } } LON:{ my $i = 0; foreach (@_LON){ for my $j (0..4){ last LON if $i+$j>90; $LON[$i+$j] = $_; } $i += 5; } } } =head1 ADDING MAPS A future version may allow you to pass map data to the constructor. In the meantime, adding maps is not in itself a big deal, perl-wise. Add a new key to the C<%MAPS> hash, with the value of an anonymous hash with the content listed below. =over 4 =item FILE scalar file name of Mercator Projection map. =item DIM anon array of dimensions of map in pixels [x,y]. You could create DIM on the fly using C, but there's probably no point, as you're almost certainly going to have to edit the map to align it with longitude and latitude (if you find a stock of public-domain maps that are already aligned, please drop the author a line). =item SPOTSIZE scalar number for the size of the map-marker spots, in pixels =item ANCHOR_PIXELS anon array of the pixel location of the arbitrary anchor pont [x,y] =item ANCHOR_LATLON anon array of the latitude/longitude of the arbitrary anchor pont [x,y] =item ANCHOR_NAME scalar name of the anchor, when marked on map =item ANCHOR_PLACE scalar place name of the anchor, when marked on map =item ONEMILE scalar representation of 1 mile in pixels =back =head1 NOTES ON LATITUDE AND LONGITUDE After L: =over 4 Zero degrees latitude is the equator, with the North pole at 90 degrees latitude and the South pole at -90 degrees latitude. one degree is approximately 69 miles. Greenwich, England is at 51.466 degrees north of the equator. Zero degrees longitude goes through Greenwich, England. Again, Each 69 miles from this meridian represents approximately 1 degree of longitude. East/West is plus/minus respectively. =back Actually, latitude and longitude vary depending upon the degree in hand: see L for more information. =head1 CAVEATS The exmaple map, london_postcodes.jpg, is inaccurate. Whilst degrees of latitude are accurate to two decimal places, Degrees of longitude are taken to be 69 miles: this isn't quite right - see L. This will be adjusted in a later version. All images must be JPEGs - PNG or other support could easily be added. =head1 REVSIONS =over 4 =item 1.2 Corrected a slight mis-positioning of points. Replaced GD with Image::Magick as I was seeing terrible JPEG output with GD. Replaced support for non-maintained C with C; evaluate a require of this at run time rather than using the apparently still shakey pragmas. Added methods to create just images and to return references to image blobs. =item 1.0 Don't remember. =item 0.25 Clean IMG path and double-header bugs =item 0.23 Added more documentation; escaping of href text =item 0.22 Added thumbnail images to index page =back =head1 SEE ALSO perl(1); L (C); L; L; L; L; L =head1 THANKS Thanks to the London.pm group for their test data and insipration, to Leon for his patience with all that mess on the list, to Philip Newton for his frankly amazing knowledge of international postcodes. Thanks also to the CIA, L, L, and L for their public-domain maps. =head1 AUTHOR Lee Goddard =head1 COPYRIGHT Copyright (C) Lee Goddard, 2001. All Rights Reserved. This module is supplied and may be used under the same terms as Perl itself. The public domain maps provided with this distribution are the property of their respective copyright holders. =cut 1; __END__ matlab: axesm('mapprojection','mercator'); displaym( worldhi(mask));