| 1 | create_tileindex.pl |
| 2 | |
| 3 | #!/usr/bin/perl |
| 4 | use strict; |
| 5 | #use warnings; |
| 6 | |
| 7 | use XBase; |
| 8 | use Cwd; |
| 9 | use mapscript; |
| 10 | use Getopt::Long; |
| 11 | use Image::Size; |
| 12 | use File::Basename; |
| 13 | use File::Find; |
| 14 | use Pod::Usage; |
| 15 | |
| 16 | our $version = 0.91; |
| 17 | our $ms37above = 0; # default mapserver version < 3.7 |
| 18 | |
| 19 | BEGIN { |
| 20 | my ($msmajor, $msminor) = ($mapscript::MS_VERSION =~ /^(\d+)\.(\d+)/o); |
| 21 | if ($msmajor > 3 or ($msmajor == 3 and $msminor > 6)) { |
| 22 | $ms37above = 1; |
| 23 | } |
| 24 | } |
| 25 | |
| 26 | # variables for command line arguments |
| 27 | my $verbose = 0; # verbosity level |
| 28 | my $imagedir = getcwd; # image directory, default is current dir |
| 29 | my $shapename = 'tileindex'; # name of shapefile to be created |
| 30 | my $extension = 'tif'; # extension of image files |
| 31 | my $imgcatdrv = ''; # image catalog drive and path |
| 32 | my $imgcatsbd = ''; # image catalog share basepath |
| 33 | my $help = ''; # you want help? you'll get it! |
| 34 | |
| 35 | GetOptions('verbose+' => \$verbose, |
| 36 | 'imagedir:s' => \$imagedir, |
| 37 | 'tileindexname:s' => \$shapename, |
| 38 | 'extension:s' => \$extension, |
| 39 | 'drvimgcat:s' => \$imgcatdrv, |
| 40 | 'sbdimgcat:s' => \$imgcatsbd, |
| 41 | 'help' => \$help); |
| 42 | |
| 43 | pod2usage( { -exitval => 1, |
| 44 | -verbose => 3} ) if $help; |
| 45 | |
| 46 | pod2usage( { -exitval => 2, |
| 47 | -verbose => 1, |
| 48 | -output => \*STDERR} ) unless $imagedir and $shapename and $extensi |
| 49 | on; |
| 50 | |
| 51 | my $NL = "\n"; |
| 52 | |
| 53 | # If tileindex shape exists, delete it! |
| 54 | for my $shpfile ("$shapename.shp", "$shapename.shx", "$shapename.dbf") { |
| 55 | if (-e $shpfile) { |
| 56 | print "deleting $shpfile\n" if $verbose > 1; |
| 57 | unlink $shpfile |
| 58 | or die "ERROR: Could not delete $shpfile: $!\n"; |
| 59 | } |
| 60 | } |
| 61 | |
| 62 | die "ERROR: Not a directory $imagedir: $!\n" unless -d $imagedir; |
| 63 | my @tfws; |
| 64 | find( \&push_tfws, $imagedir); |
| 65 | die "ERROR: No .tfw files in directory $imagedir\n" if $#tfws < 0; |
| 66 | |
| 67 | # create new shapefile |
| 68 | print "creating tileindex $shapename.shp\n\n" if $verbose > 1; |
| 69 | my $shapefile = $ms37above ? mapscript::shapefileObj->new("$shapename.shp",$mapscript::MS_SHAPEFILE_POLYGON) : shapefileObj->new("$shapename.shp",$mapscript::MS_SHAPEFILE_POLYGON); |
| 70 | my $basename = $shapename =~ /\.shp$/ ? basename($shapename,('.shp')) : $shapename; |
| 71 | # create dBASE-file for shapefile |
| 72 | unlink "$shapename.dbf"; |
| 73 | my $table = XBase->create("name" => "$shapename.dbf", |
| 74 | "field_names" => [ qw/ IMAGE XMIN YMIN XMAX YMAX LOCATION / |
| 75 | ], |
| 76 | "field_types" => [ qw/ C N N N N C/ ], |
| 77 | "field_lengths" => [ qw/ 75 20 20 20 20 127/ ], |
| 78 | "field_decimals" => [ undef, 8, 8, 8, 8, undef ]); |
| 79 | |
| 80 | # create point object for usage in shapefile |
| 81 | my $point = $ms37above ? mapscript::pointObj->new() : pointObj->new() ; |
| 82 | |
| 83 | my $i = 0; # record counter |
| 84 | foreach my $tfwfile (@tfws) { # step through all tfw-files |
| 85 | my $image = imagename($tfwfile); # name of image file |
| 86 | print "Image is $image...\n" if $verbose; |
| 87 | next unless -r $image; # skip if image does not exist |
| 88 | print "Processing $tfwfile...\n" if $verbose; |
| 89 | # calculate image coordinates |
| 90 | my $tfw = read_tfw("$tfwfile", $image); |
| 91 | # create new shape object which will contain the new polygon |
| 92 | my $shp = $ms37above ? mapscript::shapeObj->new($mapscript::MS_POLYGON) : shapeObj->new($mapscript::MS_POLYGON); |
| 93 | # create new line object which will receive the coordinates |
| 94 | my $line = $ms37above ? mapscript::lineObj->new() : lineObj->new(); |
| 95 | my ($minx, $miny, $maxx, $maxy) = (); |
| 96 | foreach my $rk (@$tfw) { # add all coordinates |
| 97 | print $$rk[0], ',', $$rk[1], $NL if $verbose > 1; |
| 98 | $point->{'x'} = $$rk[0]; # into point object |
| 99 | $point->{'y'} = $$rk[1]; |
| 100 | $line->add($point); # and point into line |
| 101 | save_maxmin($rk, \$minx, \$miny, \$maxx, \$maxy); |
| 102 | } |
| 103 | # write record into dbase file |
| 104 | (my $avimage = $image) =~ s!$imgcatsbd!$imgcatdrv!o; |
| 105 | $avimage =~ s!/!\\!og; |
| 106 | $table->set_record($i,$avimage,$minx,$miny,$maxx,$maxy,$image); |
| 107 | $shp->add($line); # add line to shape |
| 108 | $shapefile->add($shp); # add shape to shapefile |
| 109 | $i++; # increase record counter |
| 110 | print $NL if $verbose > 1; |
| 111 | } |
| 112 | |
| 113 | undef $shapefile; # close shapefile |
| 114 | undef $table; # close dbase table |
| 115 | system('shptree', $shapename); |
| 116 | print "Done.\n" if $verbose; |
| 117 | exit 0; |
| 118 | |
| 119 | #--------------------------------------------------------------------- |
| 120 | # function save_maxmin - save maximum/minimum coordinates |
| 121 | # |
| 122 | # description: compare current point koordinates with max/min x/y values |
| 123 | # and set these new if appropriate |
| 124 | # |
| 125 | # parameters : $rk - reference to coordinate list |
| 126 | # $minx - reference to min x value |
| 127 | # $miny - reference to min y value |
| 128 | # $maxx - reference to max x value |
| 129 | # $maxy - reference to max y value |
| 130 | # |
| 131 | # returns : nothing |
| 132 | # |
| 133 | # MWS remarks: |
| 134 | # |
| 135 | #--------------------------------------------------------------------- |
| 136 | sub save_maxmin { |
| 137 | my ($rk, $minx, $miny, $maxx, $maxy) = @_; |
| 138 | $$minx = $$minx ? $$rk[0] < $$minx ? $$rk[0] : $$minx : $$rk[0]; |
| 139 | $$maxx = $$maxx ? $$rk[0] > $$maxx ? $$rk[0] : $$maxx : $$rk[0]; |
| 140 | $$miny = $$miny ? $$rk[1] < $$miny ? $$rk[1] : $$miny : $$rk[1]; |
| 141 | $$maxy = $$maxy ? $$rk[1] > $$maxy ? $$rk[1] : $$maxy : $$rk[1]; |
| 142 | print STDERR "$$minx, $$miny, $$maxx, $$maxy\n" if $verbose > 1; |
| 143 | } |
| 144 | |
| 145 | |
| 146 | #--------------------------------------------------------------------- |
| 147 | # function imagename - return name of image for given tfw file |
| 148 | # |
| 149 | # description: removes extension .tfw and adds known extension |
| 150 | # from global variable $extension |
| 151 | # |
| 152 | # parameters : $img - name of tfw file |
| 153 | # |
| 154 | # returns : string with image name |
| 155 | #--------------------------------------------------------------------- |
| 156 | sub imagename{ |
| 157 | my $img = shift; |
| 158 | $img =~ s/\.tfw$//o; |
| 159 | return "$img.$extension"; |
| 160 | } |
| 161 | |
| 162 | #--------------------------------------------------------------------- |
| 163 | # function read_tfw - read tfwfile and image, return coordinates |
| 164 | # |
| 165 | # description: reads tfw file and retrieves image size, creates a list |
| 166 | # of the corner coordinates |
| 167 | # Uses Image::Size to get the size of the image |
| 168 | # |
| 169 | # parameters : $tfwfile - name of tfw file |
| 170 | # $image - name of image |
| 171 | # |
| 172 | # returns : pointer to list of coordinates |
| 173 | # |
| 174 | #--------------------------------------------------------------------- |
| 175 | sub read_tfw{ |
| 176 | my ($tfwfile, $image) = @_; |
| 177 | my ($ix, $iy, $desc) = imgsize($image); |
| 178 | die "$desc" unless $ix; |
| 179 | open(I, "< $tfwfile") or die "Can't read $tfwfile: $!"; |
| 180 | my @lines = <I>; # read file into array |
| 181 | my ($dx) = ($lines[0] =~ /(\S+)/)[0]; |
| 182 | my ($dy) = ($lines[3] =~ /(\S+)/)[0]; |
| 183 | my ($ulx) = ($lines[4] =~ /(\S+)/)[0]; |
| 184 | my ($uly) = ($lines[5] =~ /(\S+)/)[0]; |
| 185 | close I; |
| 186 | my $coords = [[$ulx,$uly], |
| 187 | [$ulx + $dx * $ix, $uly], |
| 188 | [$ulx + $dx * $ix, $uly + $dy * $iy], |
| 189 | [$ulx, $uly + $dy * $iy], |
| 190 | [$ulx,$uly]]; |
| 191 | return $coords; |
| 192 | } |
| 193 | |
| 194 | #--------------------------------------------------------------------- |
| 195 | # function push_tfws - push all tfw-files on global stack @tfw |
| 196 | # |
| 197 | # description: |
| 198 | # |
| 199 | # parameters : |
| 200 | # |
| 201 | # returns : |
| 202 | # |
| 203 | # MWS remarks: |
| 204 | # |
| 205 | #--------------------------------------------------------------------- |
| 206 | sub push_tfws{ |
| 207 | push(@tfws, $File::Find::name) if /\.tfw$/; |
| 208 | } |
| 209 | |
| 210 | 1; |
| 211 | |
| 212 | __END__ |
| 213 | |
| 214 | =head1 NAME |
| 215 | |
| 216 | create_tileindex.pl - create tileindex for mapserver and image catalog for ArcView |
| 217 | |
| 218 | =head1 SYNOPSIS |
| 219 | |
| 220 | create_tileindex.pl [--tileindexname hitif] [--extension tif] [--imagedir /tmp/hitif] [--drvimgcat y:\] [--sbdimgcat /data] [--verbose] [--help] |
| 221 | |
| 222 | =head1 DESCRIPTION |
| 223 | |
| 224 | create_tileindex.pl creates a tileindex shapefile and dbase file for the usage of tiled georeferenced images in mapserver and ArcView (TM ESRI). |
| 225 | |
| 226 | The images can be stored in a subdirectory tree, as F<create_tileindex.pl> performs a file-find starting from the given imagedir. |
| 227 | |
| 228 | After creating the tileindex, a F<shptree> command is issued to speed up mapserver access to the tiles. |
| 229 | |
| 230 | =head1 EXAMPLE |
| 231 | |
| 232 | =head2 Simple usage |
| 233 | |
| 234 | Cd into base directory of the images, issue the F<create_tileindex.pl> command. |
| 235 | A tileindex named F<tileindex> will be created in the current directory. |
| 236 | This is sufficient for mapserver usage and ArcView usage with a F<drivemap.txt> file. |
| 237 | |
| 238 | =head2 Complex usage |
| 239 | |
| 240 | create_tileindex.pl --tileindexname muctiles --extension tif --imagedir /data/tifplan --sbdimgcat /data --drvimgcat "y:" |
| 241 | |
| 242 | Short notation: |
| 243 | |
| 244 | create_tileindex.pl -t muctiles -i /data/tifplan -s /data -d "y:" |
| 245 | |
| 246 | This command creates the tileindex with the name F<muctiles> in the current directory. |
| 247 | |
| 248 | The extension of the searched image files is tif (this is the default value, so it could have been omitted). |
| 249 | |
| 250 | The starting directory of the search for image files is F</data/tifplan>. |
| 251 | |
| 252 | For the usage as an image catalog, the directory part of the image filenames is modified by |
| 253 | |
| 254 | =over 4 |
| 255 | |
| 256 | =item |
| 257 | |
| 258 | replacing from the start the value of the --sbdimgcat value with the --drvimgcat value |
| 259 | |
| 260 | =item |
| 261 | |
| 262 | replacing all forward slashes / with backslashes |
| 263 | =back |
| 264 | |
| 265 | The modified filenames are placed in the item C<IMAGE>. It's length is 75 characters. |
| 266 | |
| 267 | (For ArcView experts: The same effect could be achieved by placing an appropriate F<DRIVEMAP.TXT> in the appropriate place.) |
| 268 | |
| 269 | =head1 COMMAND LINE ARGUMENTS |
| 270 | |
| 271 | Every argument name can be given in one-dash-one-letter notation or shortened ad libitum. |
| 272 | |
| 273 | =over 4 |
| 274 | |
| 275 | =item --tileindexname (optional) |
| 276 | |
| 277 | Name (without extension!) of the tileindex to be created. If the tileindexname contains no directory part, the tileindex is created in the current directory. |
| 278 | If this argument is omitted, the name F<tileindex> is used. |
| 279 | |
| 280 | =item --extension (optional) |
| 281 | |
| 282 | Extension of the image files to be searched. Defaults to C<tif>. |
| 283 | |
| 284 | =item --imagedir (optional) |
| 285 | |
| 286 | Base directory where the image files are stored under. The search for the images starts here. |
| 287 | |
| 288 | =item drvimgcat (optional) |
| 289 | |
| 290 | Drive letter and eventually path (Windows notation) to be used when accessing the images from ArcView/Windows via the image catalog. |
| 291 | |
| 292 | =item sbdimgcat (optional) |
| 293 | |
| 294 | Windows share base directory of the image files (Unix notation). This directory will be replaced by the C<drvimgcat> value. |
| 295 | |
| 296 | =item verbose (optional) |
| 297 | |
| 298 | 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. |
| 299 | |
| 300 | =item help (optional) |
| 301 | |
| 302 | Print this documentation to stdout and exit. |
| 303 | |
| 304 | =back |
| 305 | |
| 306 | =head2 Tileindex in Mapserver |
| 307 | |
| 308 | 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. |
| 309 | To use the created tileindex in mapserver, add the following lines in your mapfile: |
| 310 | |
| 311 | LAYER |
| 312 | NAME bgl99 |
| 313 | TILEINDEX "/home/springm/perl/muctiles" |
| 314 | TYPE raster |
| 315 | END |
| 316 | |
| 317 | =head2 Image catalog in ArcView |
| 318 | |
| 319 | 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): |
| 320 | |
| 321 | =over 4 |
| 322 | |
| 323 | =item |
| 324 | |
| 325 | Click the Add Theme button. |
| 326 | |
| 327 | =item |
| 328 | |
| 329 | In the Data Source Types box, choose Image Data Source. |
| 330 | |
| 331 | =item |
| 332 | |
| 333 | Navigate to the directory that contains the image catalog you want to add. |
| 334 | Double-click on the directory name to list the image catalogs sources it contiains. |
| 335 | |
| 336 | =item |
| 337 | |
| 338 | Double-click the image catalog source you wish to add. |
| 339 | |
| 340 | =back |
| 341 | |
| 342 | =head1 LIMITATIONS |
| 343 | |
| 344 | F<create_tileindex.pl> does not yet work with geotifs a.k.a. tif files which include the reference information in their header. |
| 345 | |
| 346 | =head1 REQUIREMENTS |
| 347 | |
| 348 | F<create_tileindex.pl> uses perl 5.6.1 and is based on C<mapscript>, Version 3.6 or above. |
| 349 | |
| 350 | 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>. |
| 351 | |
| 352 | =head1 AUTHOR |
| 353 | |
| 354 | Markus W. Spring <m.spring@gmx.de> |
| 355 | |
| 356 | =head1 COPYRIGHT AND DISCLAIMER |
| 357 | |
| 358 | 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. |
| 359 | |
| 360 | 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. |
| 361 | |
| 362 | If you do not have a copy of the GNU General Public License write to the |
| 363 | Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
| 364 | |
| 365 | =cut |
| 366 | |
| 367 | # Local variables: |
| 368 | # compile-command: "perl create_tileindex.pl -t ihk_tk50 -i /data/ihk/tk50 -e tif -v -v" |
| 369 | # End: |