| 1 | = qry_point.pl = |
| 2 | 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 |
| 3 | {{{ |
| 4 | #!perl |
| 5 | #!/usr/bin/perl -w |
| 6 | # |
| 7 | # Copyright (C) 2002, Lowell Filak. |
| 8 | # You may distribute this file under the terms of the Artistic |
| 9 | # License. |
| 10 | # |
| 11 | # Given a shapefile name, a coordinate, & an item name |
| 12 | # this routine will select a shape, |
| 13 | # select all the shapes with the same item value, & create a shapefile of |
| 14 | # the selected shape(s). |
| 15 | # |
| 16 | # Required modules are mapscript (installed as part of make install), |
| 17 | # Getopt (normally included with Perl) & XBase. |
| 18 | # Please download boundary.tar.gz also, and: |
| 19 | # tar -xf boundary.tar.gz --ungzip |
| 20 | # Note: The suggested run assumes a pick point on a 600x600 image. |
| 21 | # |
| 22 | # Suggested run method = ./qry_point.pl -file=boundary -coorx=372 -coory=115 -item=loc_name |
| 23 | use mapscript; |
| 24 | use Getopt::Long; |
| 25 | use XBase; |
| 26 | # |
| 27 | # Retrieve the input values. |
| 28 | GetOptions('file=s' => \$file, 'coorx=s' => \$coorx, 'coory=s' => \$coory, 'item=s' => \$item); |
| 29 | # |
| 30 | # Check the input values. |
| 31 | if ( (!$file) || (!$coorx) || (!$coory) || (!$item) ) { |
| 32 | print "Syntax: find.pl -file=[filename] -coorx=[x_coordinate] -coory=[y_coordinate] -item=[item_name]\n"; |
| 33 | exit 0; |
| 34 | } |
| 35 | # |
| 36 | # Upcase the item name. |
| 37 | $item = uc $item; |
| 38 | # |
| 39 | # Create mapfile name. |
| 40 | my $mapfile = $file . '.map'; |
| 41 | # |
| 42 | # Open map using default map file. |
| 43 | my $map = new mapObj("$mapfile") or die('Unable to Open Default MapFile!'); |
| 44 | # |
| 45 | # Subtract one pixel. |
| 46 | # Why is this done?: I don't directly recall but I think it has to do with |
| 47 | # mapextents starting at a positive integer while image starts at 0,0. |
| 48 | $imgx = $map->{width} - 1; |
| 49 | $imgy = $map->{height} - 1; |
| 50 | # |
| 51 | # Find the extents of the map. |
| 52 | $minx = $map->{extent}->{minx}; |
| 53 | $miny = $map->{extent}->{miny}; |
| 54 | $maxx = $map->{extent}->{maxx}; |
| 55 | $maxy = $map->{extent}->{maxy}; |
| 56 | # |
| 57 | # Caculate a delta x & delta y. |
| 58 | $dx = $maxx - $minx; |
| 59 | $dy = $maxy - $miny; |
| 60 | # |
| 61 | # Divide delta x & y by pixel extents to find factor x & y. |
| 62 | $fctrx = $dx / $imgx; |
| 63 | $fctry = $dy / $imgy; |
| 64 | # |
| 65 | # Adjust to real world coordinates. |
| 66 | $coorx = $coorx * $fctrx; |
| 67 | $coory = $coory * $fctry; |
| 68 | $coorx = $coorx + $minx; |
| 69 | $coory = $maxy - $coory; |
| 70 | # |
| 71 | # |
| 72 | # Create point object for pick query. |
| 73 | $pnt = new pointObj(); |
| 74 | $pnt->{x} = $coorx; |
| 75 | $pnt->{y} = $coory; |
| 76 | # |
| 77 | # Print the point coordinates. |
| 78 | print "Selecting Using Point Coordinates: x=$coorx y=$coory\n"; |
| 79 | # |
| 80 | # Get layer for boundary query. |
| 81 | # Note: Most of this is already set in the mapfile and is here for sample |
| 82 | # only. |
| 83 | my $lyr = $map->getLayerByName("$file") or die('Unable to Open Boundary Layer!'); |
| 84 | $lyr->{status} = $mapscript::MS_ON; |
| 85 | $lyr->{type} = $mapscript::MS_LAYER_POLYGON; |
| 86 | $lyr->{data} = "$file"; |
| 87 | # |
| 88 | # Query the layer using the created point. |
| 89 | $lyr->queryByPoint($map,$pnt,$mapscript::MS_SINGLE,0); |
| 90 | # |
| 91 | # Create a resultcache object to see how many results. |
| 92 | my $rsltcache = $lyr->{resultcache}; |
| 93 | # |
| 94 | # How many matches did we find. |
| 95 | print "Found $rsltcache->{numresults} Result.\n"; |
| 96 | # |
| 97 | # Grab the first result (there should only be one). |
| 98 | my $rslt = $lyr->getResult(0); |
| 99 | # |
| 100 | # What is the shape number. |
| 101 | my $record = $rslt->{shapeindex}; |
| 102 | # |
| 103 | # Print the shape number. |
| 104 | print "The Query Found Shape #$record.\n"; |
| 105 | # |
| 106 | # Query the dbf for the item matching records. |
| 107 | # Note: The routine is written to utilize dbf files as they originally are. |
| 108 | # Normally you would want to at least add a record number field to the |
| 109 | # dbf file so you could use the DBI & DBD::XBase modules to query |
| 110 | # the db. You could also load the dbf data into an dbms and use |
| 111 | # the DBI & DBD::x modules to query once the record number field |
| 112 | # exists. |
| 113 | # |
| 114 | # Open the db handle. |
| 115 | my $dbh = new XBase "$file" or die XBase->errstr; |
| 116 | # |
| 117 | # What is the number of the key field. |
| 118 | my @names = $dbh->field_names; |
| 119 | # |
| 120 | # How many fields are there. |
| 121 | my $fldcnt = $dbh->last_field; |
| 122 | # |
| 123 | # Set the field number to initially 0. |
| 124 | my $fieldnum = 0; |
| 125 | # |
| 126 | # Loop through the fields and find the one we want. |
| 127 | for ($field=0; $field<=$fldcnt; $field++){ |
| 128 | # |
| 129 | # Is this the field we were looking for. |
| 130 | if ( $names[$field] eq $item ) { |
| 131 | # |
| 132 | # If so then exit loop. |
| 133 | $fieldnum = $field; |
| 134 | # |
| 135 | # Print the field number. |
| 136 | print "The Key Item is Field #$fieldnum.\n"; |
| 137 | last; |
| 138 | } |
| 139 | else { |
| 140 | # |
| 141 | # Fall through. |
| 142 | } |
| 143 | } |
| 144 | # |
| 145 | # Grab the key record & the key item value. |
| 146 | my @row = $dbh->get_record_nf($record, $fieldnum) or die $dbh->errstr; |
| 147 | # |
| 148 | # What is the value for the key item. |
| 149 | my $value = $row[1]; |
| 150 | # |
| 151 | # Print the key item value for the key record. |
| 152 | print "The Value of $item for Shape #$record = $value.\n"; |
| 153 | # |
| 154 | # Start the number of results at 0. |
| 155 | my $results = 0; |
| 156 | # |
| 157 | # Open the selection set shapefile. |
| 158 | # Note: There is a way to obtain a selection set without saving to a |
| 159 | # shapefile, however due to the type of data I am accustomed to, |
| 160 | # by writing to a shapefile, a type of shapefile cache can be setup. |
| 161 | # By naming all shapefiles in a particular directory in a way |
| 162 | # that allows them to be reopened for any repetitious queries |
| 163 | # the actual work of the query can be bypassed. |
| 164 | my $shapesel = new shapefileObj('selected',$mapscript::MS_SHAPEFILE_POLYGON); |
| 165 | # |
| 166 | # Open the existing shapefile for grabbing the found shapes out of. |
| 167 | my $shapefile = new shapefileObj("$file",-1); |
| 168 | # |
| 169 | # Loop through each record (there are experimental modules for using indexes |
| 170 | # available according to xbase man page). |
| 171 | for ($record=0; $record<$dbh->last_record; $record++){ |
| 172 | # |
| 173 | # Grab the record. |
| 174 | my @row = $dbh->get_record($record, "$item") or die $dbh->errstr; |
| 175 | # |
| 176 | # Is the record marked for deletion. |
| 177 | my $deleted = $row[0]; |
| 178 | if ( $deleted == 1 ) { |
| 179 | # |
| 180 | # If so then skip it. |
| 181 | next; |
| 182 | } |
| 183 | else { |
| 184 | # |
| 185 | # Fall through. |
| 186 | } |
| 187 | # |
| 188 | # Set the value for the search field. |
| 189 | my $fndvalue = $row[1]; |
| 190 | # |
| 191 | # Does the value from the field match the value for the key record. |
| 192 | if ( "$fndvalue" ne "$value" ) { |
| 193 | # |
| 194 | # If not skip it. |
| 195 | next; |
| 196 | } |
| 197 | else { |
| 198 | # |
| 199 | # Fall through. |
| 200 | } |
| 201 | # |
| 202 | # Print the found record information. |
| 203 | print "Record #$record Matches with a Value of $fndvalue - good thing :-)\n"; |
| 204 | # |
| 205 | # Increment the results counter. |
| 206 | $results = $results + 1; |
| 207 | # |
| 208 | # Create the shape object for holding the found shapes. |
| 209 | my $shape = new shapeObj(-1); |
| 210 | # |
| 211 | # Grab shape #$record and stick it into the shape holder. |
| 212 | # |
| 213 | $shapefile->get($record - 1, $shape); |
| 214 | # |
| 215 | # Add that shape to the selection set shapefile. |
| 216 | $shapesel->add($shape); |
| 217 | } |
| 218 | # |
| 219 | # Close the new shapefile. |
| 220 | undef $shapesel; |
| 221 | # |
| 222 | # Create dbf to go with it. |
| 223 | my $newdbh = $dbh->create("name" => "selected.dbf"); |
| 224 | # |
| 225 | # Reopen the selected set shapefile. |
| 226 | $shapesel = new shapefileObj("selected", -1); |
| 227 | # |
| 228 | # Get the extent of selected set. |
| 229 | $newrect = $shapesel->{bounds}; |
| 230 | $newminx = $newrect->{minx}; |
| 231 | $newmaxx = $newrect->{maxx}; |
| 232 | $newminy = $newrect->{miny}; |
| 233 | $newmaxy = $newrect->{maxy}; |
| 234 | $numseld = $shapesel->{numshapes}; |
| 235 | undef $shapesel; |
| 236 | # |
| 237 | # Print the extents. |
| 238 | print "The Extents of the Selected Set: minx=$newminx miny=$newminy maxx=$newmaxx maxy=$newmaxy.\n"; |
| 239 | # |
| 240 | # Print the number of selected records. |
| 241 | print "The Number of Selected Shapes = $numseld.\n"; |
| 242 | }}} |
| 243 | ---- |
| 244 | back to PerlMapScript |