Changes between Initial Version and Version 1 of PerlMapScriptExamples35ex7

Timestamp:

Jan 29, 2009, 6:47:11 AM (15 years ago)

Author:

jmckenna

Comment:

--

PerlMapScriptExamples35ex7

@@ +1 @@
+= qry_point.pl =
+The boundary.tar.gz is not available because I can't upload it. It is not required for the script to work, only to run the example. -sw http://www.highwayengineer.co.medina.oh.us/boundary.tar.gz
+{{{
+#!perl
+#!/usr/bin/perl -w
+#
+# Copyright (C) 2002, Lowell Filak.
+# You may distribute this file under the terms of the Artistic
+# License.
+#
+# Given a shapefile name, a coordinate, & an item name
+#   this routine will select a shape,
+#   select all the shapes with the same item value, & create a shapefile of
+#   the selected shape(s).
+#
+# Required modules are mapscript (installed as part of make install),
+#   Getopt (normally included with Perl) & XBase.
+#   Please download boundary.tar.gz also, and:
+#     tar -xf boundary.tar.gz --ungzip
+#   Note: The suggested run assumes a pick point on a 600x600 image.
+#
+# Suggested run method = ./qry_point.pl -file=boundary -coorx=372 -coory=115 -item=loc_name
+use mapscript;
+use Getopt::Long;
+use XBase;
+#
+# Retrieve the input values.
+GetOptions('file=s' => \$file, 'coorx=s' => \$coorx, 'coory=s' => \$coory, 'item=s' => \$item);
+#
+# Check the input values.
+if ( (!$file) || (!$coorx) || (!$coory) || (!$item) ) {
+  print "Syntax: find.pl -file=[filename] -coorx=[x_coordinate] -coory=[y_coordinate] -item=[item_name]\n";
+  exit 0;
+}
+#
+# Upcase the item name.
+$item = uc $item;
+#
+# Create mapfile name.
+my $mapfile = $file . '.map';
+#
+# Open map using default map file.
+my $map = new mapObj("$mapfile") or die('Unable to Open Default MapFile!');
+#
+# Subtract one pixel.
+# Why is this done?: I don't directly recall but I think it has to do with
+#   mapextents starting at a positive integer while image starts at 0,0.
+$imgx = $map->{width} - 1;
+$imgy = $map->{height} - 1;
+#
+# Find the extents of the map.
+$minx = $map->{extent}->{minx};
+$miny = $map->{extent}->{miny};
+$maxx = $map->{extent}->{maxx};
+$maxy = $map->{extent}->{maxy};
+#
+# Caculate a delta x & delta y.
+$dx = $maxx - $minx;
+$dy = $maxy - $miny;
+#
+# Divide delta x & y by pixel extents to find factor x & y.
+$fctrx = $dx / $imgx;
+$fctry = $dy / $imgy;
+#
+# Adjust to real world coordinates.
+$coorx = $coorx * $fctrx;
+$coory = $coory * $fctry;
+$coorx = $coorx + $minx;
+$coory = $maxy - $coory;
+#
+#
+# Create point object for pick query.
+$pnt = new pointObj();
+$pnt->{x} = $coorx;
+$pnt->{y} = $coory;
+#
+# Print the point coordinates.
+print "Selecting Using Point Coordinates: x=$coorx y=$coory\n";
+#
+# Get layer for boundary query.
+#   Note: Most of this is already set in the mapfile and is here for sample
+#         only.
+my $lyr = $map->getLayerByName("$file") or die('Unable to Open Boundary Layer!');
+$lyr->{status} = $mapscript::MS_ON;
+$lyr->{type} = $mapscript::MS_LAYER_POLYGON;
+$lyr->{data} = "$file";
+#
+# Query the layer using the created point.
+$lyr->queryByPoint($map,$pnt,$mapscript::MS_SINGLE,0);
+#
+# Create a resultcache object to see how many results.
+my $rsltcache = $lyr->{resultcache};
+#
+# How many matches did we find.
+print "Found $rsltcache->{numresults} Result.\n";
+#
+# Grab the first result (there should only be one).
+my $rslt = $lyr->getResult(0);
+#
+# What is the shape number.
+my $record = $rslt->{shapeindex};
+#
+# Print the shape number.
+print "The Query Found Shape #$record.\n";
+#
+# Query the dbf for the item matching records.
+#   Note: The routine is written to utilize dbf files as they originally are.
+#         Normally you would want to at least add a record number field to the
+#         dbf file so you could use the DBI & DBD::XBase modules to query
+#         the db. You could also load the dbf data into an dbms and use
+#         the DBI & DBD::x modules to query once the record number field
+#         exists.
+#
+# Open the db handle.
+my $dbh = new XBase "$file" or die XBase->errstr;
+#
+# What is the number of the key field.
+my @names = $dbh->field_names;
+#
+# How many fields are there.
+my $fldcnt = $dbh->last_field;
+#
+# Set the field number to initially 0.
+my $fieldnum = 0;
+#
+# Loop through the fields and find the one we want.
+for ($field=0; $field<=$fldcnt; $field++){
+  #
+  # Is this the field we were looking for.
+  if ( $names[$field] eq $item ) {
+    #
+    # If so then exit loop.
+    $fieldnum = $field;
+    #
+    # Print the field number.
+    print "The Key Item is Field #$fieldnum.\n";
+    last;
+  }
+   else {
+    #
+    # Fall through.
+   }
+}
+#
+# Grab the key record & the key item value.
+my @row = $dbh->get_record_nf($record, $fieldnum) or die $dbh->errstr;
+#
+# What is the value for the key item.
+my $value = $row[1];
+#
+# Print the key item value for the key record.
+print "The Value of $item for Shape #$record = $value.\n";
+#
+# Start the number of results at 0.
+my $results = 0;
+#
+# Open the selection set shapefile.
+#   Note: There is a way to obtain a selection set without saving to a
+#         shapefile, however due to the type of data I am accustomed to,
+#         by writing to a shapefile, a type of shapefile cache can be setup.
+#         By naming all shapefiles in a particular directory in a way
+#         that allows them to be reopened for any repetitious queries
+#         the actual work of the query can be bypassed.
+my $shapesel = new shapefileObj('selected',$mapscript::MS_SHAPEFILE_POLYGON);
+#
+# Open the existing shapefile for grabbing the found shapes out of.
+my $shapefile = new shapefileObj("$file",-1);
+#
+# Loop through each record (there are experimental modules for using indexes
+#   available according to xbase man page).
+for ($record=0; $record<$dbh->last_record; $record++){
+  #
+  # Grab the record.
+  my @row = $dbh->get_record($record, "$item") or die $dbh->errstr;
+  #
+  # Is the record marked for deletion.
+  my $deleted = $row[0];
+  if ( $deleted == 1 ) {
+    #
+    # If so then skip it.
+    next;
+  }
+   else {
+    #
+    # Fall through.
+   }
+  #
+  # Set the value for the search field.
+  my $fndvalue = $row[1];
+  #
+  # Does the value from the field match the value for the key record.
+  if ( "$fndvalue" ne "$value" ) {
+    #
+    # If not skip it.
+    next;
+  }
+   else {
+    #
+    # Fall through.
+   }
+  #
+  # Print the found record information.
+  print "Record #$record Matches with a Value of $fndvalue - good thing :-)\n";
+  #
+  # Increment the results counter.
+  $results = $results + 1;
+  #
+  # Create the shape object for holding the found shapes.
+  my $shape = new shapeObj(-1);
+  #
+  # Grab shape #$record and stick it into the shape holder.
+  #
+  $shapefile->get($record - 1, $shape);
+  #
+  # Add that shape to the selection set shapefile.
+  $shapesel->add($shape);
+}
+#
+# Close the new shapefile.
+undef $shapesel;
+#
+# Create dbf to go with it.
+my $newdbh = $dbh->create("name" => "selected.dbf");
+#
+# Reopen the selected set shapefile.
+$shapesel = new shapefileObj("selected", -1);
+#
+# Get the extent of selected set.
+$newrect = $shapesel->{bounds};
+$newminx = $newrect->{minx};
+$newmaxx = $newrect->{maxx};
+$newminy = $newrect->{miny};
+$newmaxy = $newrect->{maxy};
+$numseld = $shapesel->{numshapes};
+undef $shapesel;
+#
+# Print the extents.
+print "The Extents of the Selected Set: minx=$newminx miny=$newminy maxx=$newmaxx maxy=$newmaxy.\n";
+#
+# Print the number of selected records.
+print "The Number of Selected Shapes = $numseld.\n";
+}}}
+----
+back to PerlMapScript