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 nx 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