PerlMapScriptExamples35ex7
#!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 PerlMapScrip
