-
Notifications
You must be signed in to change notification settings - Fork 2
PerlMapScriptExamples35ex1
#!perl
#!/usr/bin/perl
use strict;
#use warnings;
use XBase;
use Cwd;
use mapscript;
use Getopt::Long;
use Image::Size;
use File::Basename;
use File::Find;
use Pod::Usage;
our $version = 0.91;
our $ms37above = 0; # default mapserver version < 3.7
BEGIN {
my ($msmajor, $msminor) = ($mapscript::MS_VERSION =~ /^(\d+).(\d+)/o);
if ($msmajor > 3 or ($msmajor == 3 and $msminor > 6)) {
$ms37above = 1;
}
}
my $verbose = 0; # verbosity level
my $imagedir = getcwd; # image directory, default is current dir
my $shapename = 'tileindex'; # name of shapefile to be created
my $extension = 'tif'; # extension of image files
my $imgcatdrv = ''; # image catalog drive and path
my $imgcatsbd = ''; # image catalog share basepath
my $help = ''; # you want help? you'll get it!
GetOptions('verbose+' => $verbose,
'imagedir:s' => $imagedir,
'tileindexname:s' => $shapename,
'extension:s' => $extension,
'drvimgcat:s' => $imgcatdrv,
'sbdimgcat:s' => $imgcatsbd,
'help' => $help);
pod2usage( { -exitval => 1,
-verbose => 3} ) if $help;
pod2usage( { -exitval => 2,
-verbose => 1,
-output => *STDERR} ) unless $imagedir and $shapename and $extensi
on;
my $NL = "\n";
for my $shpfile ("$shapename.shp", "$shapename.shx", "$shapename.dbf") {
if (-e $shpfile) {
print "deleting $shpfile\n" if $verbose > 1;
unlink $shpfile
or die "ERROR: Could not delete
}
}
die "ERROR: Not a directory
my @tfws;
find( &push_tfws, $imagedir);
die "ERROR: No .tfw files in directory
print "creating tileindex $shapename.shp\n\n" if $verbose > 1;
my $shapefile = $ms37above ? mapscript::shapefileObj->new("$shapename.shp",$mapscript::MS_SHAPEFILE_POLYGON) : shapefileObj->new("$shapename.shp",$mapscript::MS_SHAPEFILE_POLYGON);
my $basename =
unlink "$shapename.dbf";
my $table = XBase->create("name" => "$shapename.dbf",
"field_names" => [ qw/ IMAGE XMIN YMIN XMAX YMAX LOCATION /
],
"field_types" => [ qw/ C N N N N C/ ],
"field_lengths" => [ qw/ 75 20 20 20 20 127/ ],
"field_decimals" => [ undef, 8, 8, 8, 8, undef ]);
my $point = $ms37above ? mapscript::pointObj->new() : pointObj->new() ;
my $i = 0; # record counter
foreach my $tfwfile (@tfws) { # step through all tfw-files
my $image = imagename($tfwfile); # name of image file
print "Image is $image...\n" if $verbose;
next unless -r $image; # skip if image does not exist
print "Processing $tfwfile...\n" if $verbose;
my $tfw = read_tfw("$tfwfile", $image);
my $shp = $ms37above ? mapscript::shapeObj->new($mapscript::MS_POLYGON) : shapeObj->new($mapscript::MS_POLYGON);
my $line = $ms37above ? mapscript::lineObj->new() : lineObj->new();
my ($minx, $miny, $maxx, $maxy) = ();
foreach my $rk (@$tfw) { # add all coordinates
print $$rk[0], ',', $$rk[1], $NL if $verbose > 1;
$line->add($point); # and point into line
save_maxmin($rk, $minx, $miny, $maxx, $maxy);
}
(my $avimage = $image) =~ s!$imgcatsbd!$imgcatdrv!o;
$avimage =~ s!/!\!og;
$table->set_record($i,$avimage,$minx,$miny,$maxx,$maxy,$image);
$shp->add($line); # add line to shape
$shapefile->add($shp); # add shape to shapefile
$i++; # increase record counter
print $NL if $verbose > 1;
}
undef $shapefile; # close shapefile
undef $table; # close dbase table
system('shptree', $shapename);
print "Done.\n" if $verbose;
exit 0;
#---------------------------------------------------------------------
#---------------------------------------------------------------------
sub save_maxmin {
my ($rk, $minx, $miny, $maxx, $maxy) = @_;
$$minx = $$minx ? $$rk[0] < $$minx ? $$rk[0] : $$minx : $$rk[0];
$$maxx = $$maxx ? $$rk[0] > $$maxx ? $$rk[0] : $$maxx : $$rk[0];
$$miny = $$miny ? $$rk[1] < $$miny ? $$rk[1] : $$miny : $$rk[1];
$$maxy = $$maxy ? $$rk[1] > $$maxy ? $$rk[1] : $$maxy : $$rk[1];
print STDERR "$$minx, $$miny, $$maxx, $$maxy\n" if $verbose > 1;
}
#---------------------------------------------------------------------
#---------------------------------------------------------------------
sub imagename{
my $img = shift;
return "$img.$extension";
}
#---------------------------------------------------------------------
#---------------------------------------------------------------------
sub read_tfw{
my ($tfwfile, $image) = @_;
my ($ix, $iy, $desc) = imgsize($image);
die "$desc" unless $ix;
open(I, "< $tfwfile") or die "Can't read
my @lines = ; # read file into array
my ($dx) = ($lines[0] =~ /(\S+)/)[0];
my ($dy) = ($lines[3] =~ /(\S+)/)[0];
my ($ulx) = ($lines[4] =~ /(\S+)/)[0];
my ($uly) = ($lines[5] =~ /(\S+)/)[0];
close I;
my $coords = [[$ulx,$uly],
[$ulx + $dx * $ix, $uly],
[$ulx + $dx * $ix, $uly + $dy * $iy],
[$ulx, $uly + $dy * $iy],
[$ulx,$uly]];
return $coords;
}
#---------------------------------------------------------------------
#---------------------------------------------------------------------
sub push_tfws{
push(@tfws,
}
1;
END
== NAME ==
create_tileindex.pl - create tileindex for mapserver and image catalog for !ArcView
== SYNOPSIS ==
create_tileindex.pl [--tileindexname hitif] [--extension tif] [--imagedir /tmp/hitif] [--drvimgcat y:]
[--sbdimgcat /data] [--verbose] [--help]
== DESCRIPTION ==
create_tileindex.pl creates a tileindex shapefile and dbase file for the usage of tiled georeferenced images in mapserver and ArcView (TM ESRI).
The images can be stored in a subdirectory tree, as F<create_tileindex.pl> performs a file-find starting from the given imagedir.
After creating the tileindex, a F<shptree> command is issued to speed up mapserver access to the tiles.
= EXAMPLE =
== Simple usage ==
Cd into base directory of the images, issue the F<create_tileindex.pl> command.
A tileindex named F<tileindex> will be created in the current directory.
This is sufficient for mapserver usage and ArcView usage with a F<drivemap.txt> file.
== Complex usage ==
create_tileindex.pl --tileindexname muctiles --extension tif --imagedir /data/tifplan --sbdimgcat /data
--drvimgcat "y:"
Short notation:
create_tileindex.pl -t muctiles -i /data/tifplan -s /data -d "y:"
This command creates the tileindex with the name F<muctiles> in the current directory.
The extension of the searched image files is tif (this is the default value, so it could have been omitted).
The starting directory of the search for image files is F</data/tifplan>.
For the usage as an image catalog, the directory part of the image filenames is modified by
=over 4
=item
replacing from the start the value of the --sbdimgcat value with the --drvimgcat value
=item
replacing all forward slashes / with backslashes
=back
The modified filenames are placed in the item C<IMAGE>. It's length is 75 characters.
(For ArcView experts: The same effect could be achieved by placing an appropriate F<DRIVEMAP.TXT> in the appropriate place.)
=head1 COMMAND LINE ARGUMENTS
Every argument name can be given in one-dash-one-letter notation or shortened ad libitum.
=over 4
=item --tileindexname (optional)
Name (without extension!) of the tileindex to be created. If the tileindexname contains no directory part, the tileindex is created in the current directory.
If this argument is omitted, the name F<tileindex> is used.
=item --extension (optional)
Extension of the image files to be searched. Defaults to C<tif>.
=item --imagedir (optional)
Base directory where the image files are stored under. The search for the images starts here.
=item drvimgcat (optional)
Drive letter and eventually path (Windows notation) to be used when accessing the images from ArcView/Windows via the image catalog.
=item sbdimgcat (optional)
Windows share base directory of the image files (Unix notation). This directory will be replaced by the C<drvimgcat> value.
=item verbose (optional)
Toggles verbose output. One -v argument prints the names of the processed image files, two or more additionally print the corner coordinates of the images.
=item help (optional)
Print this documentation to stdout and exit.
=back
== Tileindex in !MapServer ==
F<create_tileindex.pl> places the names of the image file in the item C<LOCATION>, which is the default for mapserver. It's length is 127 characters.
To use the created tileindex in mapserver, add the following lines in your mapfile:
LAYER
NAME bgl99
TILEINDEX "/home/springm/perl/muctiles"
TYPE raster
END
== Image catalog in !ArcView ==
The created dbase file can be used as an image catalog in ArcView. To use this image catalog, perform the following steps (quoted from ArcView help):
=over 4
=item
Click the Add Theme button.
=item
In the Data Source Types box, choose Image Data Source.
=item
Navigate to the directory that contains the image catalog you want to add.
Double-click on the directory name to list the image catalogs sources it contiains.
=item
Double-click the image catalog source you wish to add.
=back
=head1 LIMITATIONS
F<create_tileindex.pl> does not yet work with geotifs a.k.a. tif files which include the reference information in their header.
=head1 REQUIREMENTS
F<create_tileindex.pl> uses perl 5.6.1 and is based on C<mapscript>, Version 3.6 or above.
It further uses the Perl modules C<XBase>, C<Image::Size> and <Pod::Usage>. You can get them from L<CPAN|http://search.cpan.org>.
=head1 AUTHOR
Markus W. Spring <m.spring@gmx.de>
=head1 COPYRIGHT AND DISCLAIMER
This program is Copyright 2002.2003 by Markus W. Spring. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
If you do not have a copy of the GNU General Public License write to the
Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
=cut
# Local variables:
# compile-command: "perl create_tileindex.pl -t ihk_tk50 -i /data/ihk/tk50 -e tif -v -v"
# End:
----
[wiki:PerlMapScript back to PerlMapScript