Changes between Initial Version and Version 1 of PerlMapScriptExamples35ex15

Timestamp:

Jan 29, 2009, 7:02:27 AM (15 years ago)

Author:

jmckenna

Comment:

--

PerlMapScriptExamples35ex15

@@ +1 @@
+= bound_add.pl =
+The boundary.tar.gz is available at: http://www.highwayengineer.co.medina.oh.us/boundary.tar.gz
+{{{
+#!perl
+#!/usr/bin/perl
+#
+# Copyright (C) 2002, Lowell Filak.
+# You may distribute this file under the terms of the Artistic
+# License.
+use strict;
+#
+# Given the name of an existing polygon shapefile this routine will add
+#   4 fields to the dbf file for the least bounding rectangle for each
+#   polygon and populate those fields.
+#
+# Required modules are mapscript (installed as part of make install
+#   http://mapserver.gis.umn.edu),
+#   Getopt (normally included with Perl),
+#   & XBase (cpan).
+#   Please download boundary.tar.gz also, and:
+#     tar -xf boundary.tar.gz --ungzip
+#
+# Suggested run line = ./bound_add.pl -pfile=boundary
+#
+# Include the mapscript module.
+use mapscript;
+#
+# Include the xbase and dbi modules for searching and updating values.
+use XBase;
+#
+# Include the getopt module to read input.
+use Getopt::Long;
+#
+# Grab the file name from the input.
+my $pfile='';
+&GetOptions('pfile=s' => \$pfile);
+if ( !$pfile ) {
+  print "Syntax: bound_add.pl -pfile=[in_polygon_shapefile_name]";
+  exit 0;
+}
+#
+# Create a unique name for a new mapfile for querying the polygons.
+#
+# Grab the date.
+my ($sec,$min,$hr,$mdy,$mnth,$yr,$wdy,$ydy,$isdst) = localtime;
+#
+# Create the name.
+my $sfile = "T$hr$min$sec";
+#
+# Open the mapfile for writing.
+open(MAPFILE, ">$sfile.map");
+#
+# Open the existing polygon shapefile.
+
+my $inshpf = new shapefileObj($pfile, -1) or die "Unable to open shapefile $pfile.";
+#
+# What are the extents.
+my $inshpminx = $inshpf->{bounds}->{minx};
+my $inshpminy = $inshpf->{bounds}->{miny};
+my $inshpmaxx = $inshpf->{bounds}->{maxx};
+my $inshpmaxy = $inshpf->{bounds}->{maxy};
+#
+# Open the existing dbf file for appending fields.
+# Thanks to: Chris Stuber.
+my $dbh = new XBase "$pfile.dbf" or die XBase->errstr;
+my @fn = $dbh->field_names();
+my @ft = $dbh->field_types();
+my @fl = $dbh->field_lengths();
+my @fd = $dbh->field_decimals();
+#
+# Push additional values into each
+# of the arrays above. (ie new Columns)
+push @fn, "recno","minx","miny","maxx","maxy";
+push @ft, "N","N","N","N","N";
+push @fl, "9","20","20","20","20";
+push @fd, "0","8","8","8","8";
+#
+my $newtable = XBase->create("name" => "$sfile.dbf", "field_names" => [@fn], "field_types" => [@ft], "field_lengths" => [@fl], "field_decimals" => [@fd] ) or die XBase->errstr;
+for my $x (0 .. $dbh->last_record) {
+  my @rec = $dbh->get_record($x);
+  my $deleted = shift @rec;
+  next if ($deleted > 0);
+  #
+  # push new data onto @rec or leave empty
+  print "Copying Record $x\n";
+  push @rec,($x);
+  $newtable->set_record($x,@rec) or die XBase->errstr;
+}
+#
+# Close the dbf file, replace it, and reopen it for setting values.
+undef $newtable;
+undef $dbh;
+unlink "$pfile.dbf";
+rename "$sfile.dbf","$pfile.dbf";
+$dbh = new XBase "$pfile.dbf" or die XBase->errstr;
+#
+# Create the contents of the mapfile.
+print MAPFILE <<EOF;
+#
+NAME $sfile
+STATUS ON
+SIZE 600 600
+SYMBOLSET "$sfile.sym"
+EXTENT $inshpminx $inshpminy $inshpmaxx $inshpmaxy
+UNITS FEET
+SHAPEPATH ""
+IMAGECOLOR 255 255 255
+LAYER
+  NAME bnd_qry
+  TYPE POLYGON
+  STATUS ON
+  DATA "$pfile"
+  TEMPLATE 'bogus.html'
+  CLASS
+    COLOR 255 0 0
+    NAME "bnd_qry"
+  END
+END
+END
+EOF
+#
+# Close the mapfile.
+close MAPFILE;
+#
+# Open the symbol file for writing.
+open(SYMFILE, ">$sfile.sym");
+#
+# Create the contents of the symbol file.
+print SYMFILE <<EOF;
+SYMBOLSET
+END
+EOF
+#
+# Close the symbol file.
+close SYMFILE;
+#
+# How many polygons are there.
+my $innumshp = $inshpf->{numshapes};
+#
+# Create the mapobject.
+my $map = new mapObj("$sfile.map") or die("Unable to Open Default MapFile $sfile.map!");
+#
+# Create the layer object for the queries.
+my $lyr = $map->getLayerByName("bnd_qry") or die('Unable to Open Polygon Layer!');
+#
+# Set the default query result to blank.
+my @row = ();
+#
+# Create the shape holder.
+my $inpol = new shapeObj(-1);
+#
+# Loop through each polygon and record.
+for (my $innum=0; $innum<$innumshp; $innum++ ) {
+  print "Recording Polygon #$innum...\n";
+  #
+  # Grab the polygon by number.
+  my $junk = $inshpf->get($innum, $inpol);
+  #
+  # Grab the bounds of the polygon.
+  my $minx = $inpol->{bounds}->{minx};
+  my $maxx = $inpol->{bounds}->{maxx};
+  my $miny = $inpol->{bounds}->{miny};
+  my $maxy = $inpol->{bounds}->{maxy};
+  #
+  # Grab the dbf record.
+  my @recd = $dbh->get_record($innum);
+  my $deleted = shift @recd;
+  my $grbg = pop(@recd);
+  my $grbg = pop(@recd);
+  my $grbg = pop(@recd);
+  my $grbg = pop(@recd);
+  #
+  # Push the values into place.
+  push @recd,($minx,$miny,$maxx,$maxy);
+  #
+  # Record the new record.
+  $dbh->set_record($innum,@recd) or die XBase->errstr;
+}
+#
+# Get rid of the temporary mapfile & symbol file.
+unlink "$sfile.map";
+unlink "$sfile.sym";
+}}}
+----
+back to PerlMapScript