PerlMapScriptExamples35ex8
#!perl
#!/usr/bin/perl
#
# Copyright (C) 2002, Lowell Filak.
# You may distribute this file under the terms of the Artistic
# License.
#
# Given the name of an existing palm database and the name
# of an existing point shapefile this routine will append the points
# in the pdb to the shapefile.
# Given just the name of an existing shapefile the routine will attempt
# to use pilot-xfer to download the pdb file and append the points to the
# shapefile.
# Given just the name of an existing pdb file this routine will create a
# new shapefile of the points in the pdb file.
# Given neither name this routine will attempt to use pilot-xfer to download
# the pdb file and create a new point shapefile from it.
# Notes: The fields in the pdb file should match the fields in the
# existing shapefile (dbf) or the assignments will either be
# wrong or will cause the routine to bomb.
# The pdb file for download is assumed to be StickeDB.pdb and the routine
# is written to read sticke style pdb files only.
# The pdb reading section of this routine is not complete but is setup
# somewhat generic and should be extendable to any sticke database
# schema.
# The pilot-xfer download line assumes the default pilot device
# (/dev/pilot) exists.
# The routine also assumes a *n*x system, please change command
# lines accordingly.
# If nad support is needed in proj.4 please verify that the ntv1_can.dat
# file is included before compiling. If not, grab a newer release.
#
# Required modules are mapscript (installed as part of make install
# http://mapserver.gis.umn.edu),
# Getopt (normally included with Perl),
# Palm (p5-Palm-1.1.5 http://theoryx5.uwinnipeg.ca/CPAN/data/p5-Palm/Palm/Raw.html),
# & XBase (cpan).
# Please download StickeDB.pdb also.
#
# Additional requirements are: a working pilot-xfer (pilot-link http://www.pilot-link.org/)
# installation,
# a working StickePad.prc and StickePlates.prc (StickeV2Programs
# http://www.cs.ukc.ac.uk/projects/mobicomp/Fieldwork/) on a
# PalmOS handheld device, & a working proj.4 install compiled with
# the optional nad files in place and with the cs2cs
# command working (www.remotesensing.org/proj/).
#
# Current GPS information: Palm IIIX-PDA, Garmin Etrex Summit-GPS, Blue
# Hills Innovations-Garmin2Palm cable (http://www.blue-hills-innovations.com).
#
# Suggested run line = ./tcounts.pl -pdbfile=StickeDB -sfile=traffic
#
# Syntax: tcounts.pl -pdbfile=[in_pdb_filename] -sfile=[out_shapefile_name]
#
# Include the pdb and pdb-raw modules.
use Palm::PDB;
use Palm::Raw;
#
# Include the mapscript module.
use mapscript;
#
# Include the xbase module for creating the dbf records.
use XBase;
#
# Include the getopt module to read input.
use Getopt::Long;
#
# Helpful definitions for StickeDB.pdb:
# I view the structure as very similar to an rdbms.
# Database - refers to the pdb file itself.
# Table - refers to the rdbms-like table name included on every record.
# Note: Each record can belong to a different table or even a different
# table deffinition under the same table name!
# Note: Tables are refered to as 'templates' inside sticke.
# Record - refers to the entire 'data' portion returned by the pdb->data obj.
# Note: Records are refered to as 'notes' inside of sticke.
# Field - refers to the section of the 'data' portion of the record which
# spans from the beginning of one field name to the beginning of the
# next.
# Note: Fields are refered to as both 'fields' and 'items' inside of sticke.
# Part - refers to the sections of a field that define the schema of the
# field (schema - data type, constraints, etc).
#
# Grab the file names from the input.
&GetOptions('pdbfile=s' => \$pdbfile, 'sfile=s' => \$sfile);
if ( !$sfile ) {
#
# Create a unique name for the shapefile based on date and process number.
#
# Grab the time.
($sec,$min,$hr,$mdy,$mnth,$yr,$wdy,$ydy,$isdst) = localtime;
#
# Grab the process id.
$spid = $$;
#
# Create the name & make sure it is no longer than 8 characters.
$sfile = substr("$hr$min$sec$spid", -8);
}
if( !$pdbfile ) {
#
# Download the pdb file.
system("pilot-xfer -f StickeDB");
#
# Set the pdb file name.
$pdbfile = 'StickeDB';
}
#
# Create the pdb object on the pdb file.
my $pdb = new Palm::PDB;
$pdb->Load("$pdbfile.pdb");
#
# How many pdb records are there.
my @records = @{$pdb->{records}};
my $numrecs = scalar(@records);
#
# Create the information array for each field/data type.
# Note: The routine is incomplete at this time because we currently only use
# 7-number & 4-location but all types are here for documentation.
my @types = ('bearing', 'boolean', 'date', 'textline', 'location', 'unused', 'notepad', 'number', 'picklist', 'subnote', 'time');
#
# Create the field type number-of-parts array.
my @parts = (0,0,0,0,23,0,0,11,0,0,0);
#
# Create the field types unpack string array.
# For location [offset+10]=dontno5, [offset+11]=latdegrees,
# [offset+12]=dontno6, [offset+13]=latminuteswhole,
# [offset+14]=dontno7, [offset+15]=latminutesdecimal,
# [offset+16]=elevation, [offset+17]=dontno8, [offset+18]=longdegrees,
# [offset+19]=dontno9, [offset+20]=longminuteswhole,
# [offset+21]=dontno10, [offset+22]=longminutesdecimal
# Note: At this point I can't find the NSEW/+- indication for lat/lon!
# For number [offset+10]=number
my @ustring = (' a*', ' a*', ' a*', ' a*', ' l n a2 n a2 n s a2 n a2 n a2 n', ' a*', ' a*', ' N', ' a*', ' a*', ' a*');
#
# Create the array for the pdb-field-type to dbf-field-type conversion.
my @dbfftype = ('C', 'L', 'D', 'C', 'C', 'C', 'C', 'N', 'C', 'C', 'N');
#
# Create the array for the pdb-field-size to dbf-field-size conversion.
my @dbffsize = ('255', '1', '8', '255', '31', '0', '255', '11', '255', '255', '10');
#
# Create the array for the pdb-field-decimal to dbf-field-decimal conversion.
# No need for this now. All decimals should be null going into the dbf file.
#
# Create the array for tracking field offsets.
# To be used later while creating dbf records for each gps point.
my @offsets = ();
#
# Create the initial unpack string.
my $unpackstr = "";
#
# Create the initial data array.
my @recordinfo = ();
#
# Initialize the dbf record count to 0.
my $dbfreccnt = 0;
#
# Does the dbf file already exist or does it yet to exist.
if ( -e "$sfile.dbf" ) {
#
# Open the existing dbf file for appending to.
$dbh = new XBase "$sfile.dbf" or die XBase->errstr;
#
# To be able to increment the record # starting at the last existing
# record how many records are there.
$dbfreccnt = $dbh->last_record + 1;
}
else {
$dbfreccnt = -1;
}
#
# Does the shapefile already exist or is it yet to exist.
if ( -e "$sfile.shp" ) {
#
# Move the existing shapefile to a temp name.
# This is done because the -1 option on shapefileObj open
# only allows for read not append.
# However as (hopefully) shown below this is not hard to
# implement inside mapscript.
system("mv $sfile.shp thistemp.shp; mv $sfile.shx thistemp.shx; touch thistemp.dbf");
#
# Open the existing file.
$ecounts = new shapefileObj("thistemp",-1);
#
# Create the replacement shapefile.
$tcounts = new shapefileObj("$sfile",$mapscript::MS_SHAPEFILE_POINT);
#
# Create the transfer point object.
my $trnspnt = new pointObj();
#
# Loop through each existing point and recreate it in the new shapefile.
for ($epnt=0; $epnt<$dbfreccnt; $epnt++) {
#
# Get the existing point.
$ecounts->getPoint($epnt,$trnspnt);
#
# Put the point into the new shapefile.
$tcounts->addPoint($trnspnt);
}
}
else {
#
# Create the new file.
$tcounts = new shapefileObj("$sfile",$mapscript::MS_SHAPEFILE_POINT);
}
#
# Create the point object for insertion into the shapefile.
my $pnt = new pointObj();
#
# Loop through each record.
# [0]=dontno1, [1]=tablenamechars, [2]=tablename, [3]=dontno2, [4]=#offields
for ($recrd=1; $recrd<$numrecs; $recrd++) {
#
# Create the array for tracking field offsets.
# To be used later while creating dbf records for each gps point.
my @offsets = ();
#
# Set the initial value for unpacking table name.
$unpackstr = "a38 n";
@recordinfo = unpack($unpackstr, $records[$recrd]->{data});
#
# The character count returned is actual + 1.
$recordinfo[1] = $recordinfo[1] - 1;
#
# Unpack the dontno1 and the table name length.
@recordinfo = unpack($unpackstr, $records[$recrd]->{data});
#
# The character count returned is actual + 1.
$recordinfo[1] = $recordinfo[1] - 1;
#
# Add the remainder of the record info to the unpack string
# (name, dontno2, #offields).
$unpackstr = $unpackstr . " a$recordinfo[1] a3 n";
#
# Add the first 10 parts of the first field info to the unpack string.
# All fields appear to have these in common even if they are blank
# for fields that do not use the particular part.
# (fieldname, dontno3, datatype, isrange, null, upperlimit, lowerlimit,
# step, dontno4, fieldsize).
# [offset+0]=fieldname, [offset+1]=dontno3, [offset+2]=datatype
# [offset+3]=isrange, [offset+4]=null,
# [offset+5]=uppperlimit, [offset+6]=lowerlimit, [offset+7]=step,
# [offset+8]=dontno4, [offset+9]=fieldsize
$unpackstr = $unpackstr . " A19 a10 n n a N N N a14 n";
#
# Set the inital value for the field offset
# (the number of parts for the previous field(s)).
my $fieldoffset = 0;
#
# Grab the rest of the record info and
# the field info up to the data length indicator.
($recordinfo[0], $recordinfo[1], $recordinfo[2], $recordinfo[3], $recordinfo[4], @fieldinfo) = unpack $unpackstr, $records[$recrd]->{data};
#
# The character count returned is actual + 1.
$recordinfo[1] = $recordinfo[1] - 1;
#
#
# Print the record info to see if we got this right.
#print "\nRecord # = $recrd\nNumber of Characters in Table Name = $recordinfo[1]\nTable Name = $recordinfo[2]\nNumber of Fields = $recordinfo[4]\n";
# Loop through each field.
for ($fld=0; $fld<$recordinfo[4]; $fld++) {
#
# The actual field number to print is fld + 1.
my $fldprint = $fld + 1;
#
# Grab the field info up to the data length indicator.
($recordinfo[0], $recordinfo[1], $recordinfo[2], $recordinfo[3], $recordinfo[4], @fieldinfo) = unpack $unpackstr, $records[$recrd]->{data};
#
# The character count returned is actual + 1.
$recordinfo[1] = $recordinfo[1] - 1;
#
# What is the length of the data.
my $dlength = $fieldinfo[$fieldoffset+9];
#
# The field type comes in strange sometimes so this should truncate it
# so it only contains values of 0-10.
$fieldinfo[$fieldoffset+2] = 256 * ( ( $fieldinfo[$fieldoffset+2] / 256 ) - ( int( $fieldinfo[$fieldoffset+2] / 256 ) ) );
#
# Okay, the same thing happens with the range.
$fieldinfo[$fieldoffset+3] = 256 * ( ( $fieldinfo[$fieldoffset+3] / 256 ) - ( int( $fieldinfo[$fieldoffset+3] / 256 ) ) );
#
# Add to the unpack string the unpack string for the field type.
$unpackstr = $unpackstr . $ustring[$fieldinfo[$fieldoffset+2]];
#
# For some reason the type appears to be 8-bit instead if 16. So
# to make sure
#
# Add to the array the rest of the parts for the field.
($recordinfo[0], $recordinfo[1], $recordinfo[2], $recordinfo[3], $recordinfo[4], @fieldinfo) = unpack $unpackstr, $records[$recrd]->{data};
#
# Escape out any unprintable characters in the field name.
$fieldinfo[$offsets[$iname]+0] = uc($fieldinfo[$offsets[$iname]+0]);
$fieldinfo[$offsets[$iname]+0] =~ s/[^\x41-\x5A]//g;
#
# The field type comes in strange sometimes so this should truncate it
# so it only contains values of 0-10.
# (binary/unpack guru applications now being accepted).
# Note: Basically this divides by base 16 to move the number 2 decimal
# places left then truncates the whole number and multiplies by
# base 16 to move the decimal 2 places right.
$fieldinfo[$fieldoffset+2] = 256 * ( ( $fieldinfo[$fieldoffset+2] / 256 ) - ( int( $fieldinfo[$fieldoffset+2] / 256 ) ) );
#
# Okay, the same thing happens with the range.
$fieldinfo[$fieldoffset+3] = 256 * ( ( $fieldinfo[$fieldoffset+3] / 256 ) - ( int( $fieldinfo[$fieldoffset+3] / 256 ) ) );
#
# Print the field info to see if we got this right.
#print "Field Offset = $fieldoffset\nField $fldprint Name = $fieldinfo[$fieldoffset+0]\nData Type = $fieldinfo[$fieldoffset+2]\nIsRange = $fieldinfo[$fieldoffset+3]\nUpper Limit = $fieldinfo[$fieldoffset+5]\nLower Limit = $fieldinfo[$fieldoffset+6]\nStep = $fieldinfo[$fieldoffset+7]\nField Size = $fieldinfo[$fieldoffset+9]\n";
#
# How many data parts are there.
# The total number of field parts - 10 is the number of data parts.
my $dparts = $parts[$fieldinfo[$fieldoffset+2]];
#
# Loop through each of the field value parts.
for ($dpart=10; $dpart<$dparts; $dpart++) {
#
# The actual data part id is the current dpart - 9 (0 thru 9 of the
# field array).
my $dprint = $dpart - 9;
#
# Print the field info to see if we got this right.
#print "Data Value $dprint = $fieldinfo[$fieldoffset+$dpart]\n";
}
#
# If the field is a location convert the lat/long to state plane.
if ( $fieldinfo[$fieldoffset+2] == 4 ) {
#
# Do the convert.
# Bunches of notes: The projection name is latlong but supply
# the coordinates as long/lat.
# The +to section contains units of us-ft but MUST specify
# false_east(x_0) in meters.
# An indespensible resource was:
# http://www.edc.uri.edu/nrs/classes/NRS522/Tools/StatePlaneZones.htm
# Note: If I was smart I would have used the pointObj project method.
system("echo \'$fieldinfo[$fieldoffset+18]d$fieldinfo[$fieldoffset+20].$fieldinfo[$fieldoffset+22]W $fieldinfo[$fieldoffset+11]d$fieldinfo[$fieldoffset+13].$fieldinfo[$fieldoffset+15]N\' | cs2cs +proj=latlong +datum=NAD83 +to +proj=lcc +datum=NAD27 +units=ft +lon_0=-82.5 +lat_0=39.666666667 +lat_1=40.433333333 +lat_2=41.433333333 +x_0=609601.21920 +y_0=0 > /tmp/coordinates");
#
# Open the coordinate file.
open(COORDS,"</tmp/coordinates");
#
# Read the coordinates in.
my @coords = split('\t', <COORDS>);
my @northelev = split(' ',$coords[1]);
#
# Print out the coordinates to see if we have this right.
#print "Easting = $coords[0], Northing = $northelev[0], Elevation = $fieldinfo[$fieldoffset+16]\n";
#
# Close the coordinate file.
close COORDS;
#
# Set the x & y for the point object.
$pnt->{x} = $coords[0];
$pnt->{y} = $northelev[0];
#
# Add the point to the shapefile.
$tcounts->addPoint($pnt);
}
#
# Print the unpack string to see if we got this right.
#print "UnPack String = $unpackstr\n";
#
# Add the next fields standard 10 parts to the unpack string.
$unpackstr = $unpackstr . " A19 a10 n n a N N N a14 n";
#
# Record where this field started at.
$offsets[$fld] = $fieldoffset;
#
# Set the field offset to include the now completed field.
$fieldoffset = $fieldoffset + $parts[$fieldinfo[$fieldoffset+2]];
}
#
# Does the dbf need created and is this the first record.
if ( ( $dbfreccnt == -1 ) && ( $recrd == 1 ) ) {
#
# Set the record count to 0.
$dbfreccnt = 0;
#
# How many fields are there.
my $fldcnt = scalar(@offsets);
#
# Initialize the field names, type, length, & decimal strings to blank.
my $fldnames = '';
my $fldtypes = '';
my $fldlenth = '';
my $flddecml = '';
#
# Loop through each field and concatenate the name, type, length, & decimal together.
for ($iname=0; $iname<$fldcnt; $iname++) {
#
# Escape out any unprintable characters in the field name.
$fieldinfo[$offsets[$iname]+0] = uc($fieldinfo[$offsets[$iname]+0]);
$fieldinfo[$offsets[$iname]+0] =~ s/[^\x41-\x5A]//g;
#
# The field type comes in strange sometimes so this should truncate it
# so it only contains values of 0-10.
# (binary/unpack guru applications now being accepted).
# Note: Basically this divides by base 16 to move the number 2 decimal
# places left then truncates the whole number and multiplies by
# base 16 to move the decimal 2 places right.
$fieldinfo[$offsets[$iname]+2] = 256 * ( ( $fieldinfo[$offsets[$iname]+2] / 256 ) - ( int( $fieldinfo[$offsets[$iname]+2] / 256 ) ) );
#
# Okay, the same thing happens with the range.
$fieldinfo[$offsets[$iname]+3] = 256 * ( ( $fieldinfo[$offsets[$iname]+3] / 256 ) - ( int( $fieldinfo[$offsets[$iname]+3] / 256 ) ) );
#
# Concatenate the field name.
$fldnames = $fldnames . ' "' . $fieldinfo[$offsets[$iname]+0] . '"';
#
# Concatenate the field types.
$fldtypes = $fldtypes . ' "' . $dbfftype[$fieldinfo[$offsets[$iname]+2]] . '"';
#
# Concatenate the field lengths.
$fldlenth = $fldlenth . ' "' . $dbffsize[$fieldinfo[$offsets[$iname]+2]] . '"';
#
# Concatenate the field decimals.
# All undef right now.
$flddecml = $flddecml . ' "undef"';
#
# If this is not the last field throw in a comma.
if ( $iname != ( $fldcnt - 1 ) ) {
$fldnames = $fldnames . ',';
$fldtypes = $fldtypes . ',';
$fldlenth = $fldlenth . ',';
$flddecml = $flddecml . ',';
}
}
#
# Add the fields for the record number and error flag.
$fldnames = $fldnames . ', "RECORD", "ERRFLAG"';
$fldtypes = $fldtypes . ', "N", "N"';
$fldlenth = $fldlenth . ', "6", "2"';
$flddecml = $flddecml . ', "undef", "undef"';
#
# Create the xbase call.
my $xbcall = 'XBase->create(name => "' . $sfile . '.dbf", field_names => [' . $fldnames . ' ], field_types => [' . $fldtypes . ' ], field_lengths => [' . $fldlenth . ' ], field_decimals => [' . $flddecml . ' ]) or die XBase->errstr;';
#
# Print out the create line to see if we got this right.
#print "Field Names = $fldnames\nField Types = $fldtypes\nField Sizes = $fldlenth\nField Decimals = $flddecml\n";
#
# Create the dbf file.
$dbh = eval($xbcall);
}
#
# Add the data for this pdb record to the dbf file.
#
# Start the xbase add-record call.
my $xbadd = '$dbh->set_record($dbfreccnt,';
#
# How many fields are there.
my $fldcnt = scalar(@offsets);
#
# Go through each field and concatenate the values together.
for ($iname=0; $iname<$fldcnt; $iname++) {
#
# The field type comes in strange sometimes so this should truncate it
# so it only contains values of 0-10.
# (binary/unpack guru applications now being accepted).
# Note: Basically this divides by base 16 to move the number 2 decimal
# places left then truncates the whole number and multiplies by
# base 16 to move the decimal 2 places right.
$fieldinfo[$offsets[$iname]+2] = 256 * ( ( $fieldinfo[$offsets[$iname]+2] / 256 ) - ( int( $fieldinfo[$offsets[$iname]+2] / 256 ) ) );
#
# Is this a number type record.
if ( $fieldinfo[$offsets[$iname]+2] == 7 ) {
$xbadd = $xbadd . $fieldinfo[$offsets[$iname]+10];
}
#
# Is this a location type record.
if ( $fieldinfo[$offsets[$iname]+2] == 4 ) {
$xbadd = $xbadd . '"' . $fieldinfo[$offsets[$iname]+18] . 'd' . $fieldinfo[$offsets[$iname]+20] . '.' . $fieldinfo[$offsets[$iname]+22] . 'W,' . $fieldinfo[$offsets[$iname]+11] . 'd' . $fieldinfo[$offsets[$iname]+13] . '.' . $fieldinfo[$offsets[$iname]+15] . 'N,' . $fieldinfo[$offsets[$iname]+16] . '"';
}
#
# If this is not the last field throw in a comma.
if ( $iname != ( $fldcnt - 1 ) ) {
$xbadd = $xbadd . ',';
}
}
#
# Add the closer to the end of the xbase add-record call.
$xbadd = $xbadd . ', ' . $dbfreccnt . ', 0);';
#
# Print the xbase add-record line to see if we got this right.
#print "$xbadd\n";
#
# Add the record to the dbf file.
eval($xbadd);
#
# Increment the record counter.
$dbfreccnt = $dbfreccnt + 1;
}
#
# Close the new shapefile.
undef $tcounts;
#
# Close the dbf handle/file.
undef $dbh;
#
# Get rid of temporary shapefiles if needed.
if ( -e "thistemp.shp" ) {
unlink "thistemp.shp";
unlink "thistemp.shx";
unlink "thistemp.dbf";
}
back to PerlMapScrip
