= create_tileindex.pl = {{{ #!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; } } # variables for command line arguments 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"; # If tileindex shape exists, delete it! 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 $shpfile: $!\n"; } } die "ERROR: Not a directory $imagedir: $!\n" unless -d $imagedir; my @tfws; find( \&push_tfws, $imagedir); die "ERROR: No .tfw files in directory $imagedir\n" if $#tfws < 0; # create new shapefile 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 = $shapename =~ /\.shp$/ ? basename($shapename,('.shp')) : $shapename; # create dBASE-file for shapefile 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 ]); # create point object for usage in shapefile 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; # calculate image coordinates my $tfw = read_tfw("$tfwfile", $image); # create new shape object which will contain the new polygon my $shp = $ms37above ? mapscript::shapeObj->new($mapscript::MS_POLYGON) : shapeObj->new($mapscript::MS_POLYGON); # create new line object which will receive the coordinates 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; $point->{'x'} = $$rk[0]; # into point object $point->{'y'} = $$rk[1]; $line->add($point); # and point into line save_maxmin($rk, \$minx, \$miny, \$maxx, \$maxy); } # write record into dbase file (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; #--------------------------------------------------------------------- # function save_maxmin - save maximum/minimum coordinates # # description: compare current point koordinates with max/min x/y values # and set these new if appropriate # # parameters : $rk - reference to coordinate list # $minx - reference to min x value # $miny - reference to min y value # $maxx - reference to max x value # $maxy - reference to max y value # # returns : nothing # # MWS remarks: # #--------------------------------------------------------------------- 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; } #--------------------------------------------------------------------- # function imagename - return name of image for given tfw file # # description: removes extension .tfw and adds known extension # from global variable $extension # # parameters : $img - name of tfw file # # returns : string with image name #--------------------------------------------------------------------- sub imagename{ my $img = shift; $img =~ s/\.tfw$//o; return "$img.$extension"; } #--------------------------------------------------------------------- # function read_tfw - read tfwfile and image, return coordinates # # description: reads tfw file and retrieves image size, creates a list # of the corner coordinates # Uses Image::Size to get the size of the image # # parameters : $tfwfile - name of tfw file # $image - name of image # # returns : pointer to list of coordinates # #--------------------------------------------------------------------- sub read_tfw{ my ($tfwfile, $image) = @_; my ($ix, $iy, $desc) = imgsize($image); die "$desc" unless $ix; open(I, "< $tfwfile") or die "Can't read $tfwfile: $!"; 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; } #--------------------------------------------------------------------- # function push_tfws - push all tfw-files on global stack @tfw # # description: # # parameters : # # returns : # # MWS remarks: # #--------------------------------------------------------------------- sub push_tfws{ push(@tfws, $File::Find::name) if /\.tfw$/; } 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 performs a file-find starting from the given imagedir. After creating the tileindex, a F command is issued to speed up mapserver access to the tiles. = EXAMPLE = == Simple usage == Cd into base directory of the images, issue the F command. A tileindex named F will be created in the current directory. This is sufficient for mapserver usage and ArcView usage with a F 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 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. 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. It's length is 75 characters. (For ArcView experts: The same effect could be achieved by placing an appropriate F 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 is used. =item --extension (optional) Extension of the image files to be searched. Defaults to C. =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 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 places the names of the image file in the item C, 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 does not yet work with geotifs a.k.a. tif files which include the reference information in their header. =head1 REQUIREMENTS F uses perl 5.6.1 and is based on C, Version 3.6 or above. It further uses the Perl modules C, C and . You can get them from L. =head1 AUTHOR Markus W. Spring =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]