Changes between Initial Version and Version 1 of PerlMapScriptExamples35ex1

Timestamp:

Jan 28, 2009, 1:53:35 PM (15 years ago)

Author:

jmckenna

Comment:

--

PerlMapScriptExamples35ex1

@@ +1 @@
+create_tileindex.pl
+
+#!/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 = <I>;              # 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__
+
+=head1 NAME
+
+create_tileindex.pl - create tileindex for mapserver and image catalog for ArcView
+
+=head1 SYNOPSIS
+
+  create_tileindex.pl [--tileindexname hitif]                        [--extension tif]                              [--imagedir /tmp/hitif]                        [--drvimgcat y:\]                              [--sbdimgcat /data]                            [--verbose]                                    [--help]
+
+=head1 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.
+
+=head1 EXAMPLE
+
+=head2 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.
+
+=head2 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
+
+=head2 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
+
+=head2 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: