Perl Script for DWAF national chemical water quality monitoring project

Handles conversion from Water Management System output to flat ASCII.
#!/usr/bin/perl -w
# wms2wmrq.pl
# f:/b-rpd/magda/*.unl = data
# see sample.unl for a 3 record sample
# aww onerecord for a 1 line sample
# Willie Geldenhuys IWQS DWAF 2001

use strict;
use English;

if ($#ARGV != 0) {
    print "usage: wms2wmrq.pl \
where .unl contains data from WMS in a certain format, eg...\
88493|ZALEXBAY1  TAP IN ALEXBAY FROM BOREHOLES AT OPPENHEIMER BRID|-28.566111|16.508056|D|97268768|1997-03-18|07:00:00|||0.0|0.0|HGCL2|F-Diss-Water|0.22||\
The output will be written to .wmq\
    and will be as close as possible to the WaterMarque format\
And debug stuff will be written to .dbg\n";
    exit 0;
}
my $delimiter = '\|';
my $filename = $ARGV[0];
open (INF, "$filename.unl") || die "error opening datafile $filename.unl";
open (ERRF, ">$filename.dbg") || die "error opening output file $filename.dbg";
open (OUTF, ">$filename.wmq") || die "error opening output file $filename.wmq";

my ($featureid, $description, $sampleid, $region, $date, $time);
my ($enddepth, $preserve, $name, $value, $oldid);
my %wmrq = (
	    'Na-Diss-Water',        -9999,
	    'K-Diss-Water',         -9999,
	    'Ca-Diss-Water',        -9999,
	    'Mg-Diss-Water',        -9999,
	    'pH-Diss-Water',	    -9999,
	    'EC-Phys-Water',	    -9999,
	    'Cl-Diss-Water',	    -9999,
	    'SO4-Diss-Water',	    -9999,
	    'TAL-Diss-Water',	    -9999,
	    'F-Diss-Water',	    -9999,
	    'PO4-P-Diss-Water',	    -9999,
	    'NH4-N-Diss-Water',	    -9999,
	    'NO3+NO2-N-Diss-Water', -9999,
	    'Si-Diss-Water',	    -9999,
	    'KJEL N-Tot-Water',	    -9999,
	    'P-Tot-Water',          -9999,
	    'DMS-Tot-Water',        -9999,
	    'B-Diss-Water',         -9999);

my @wmrq = (
	    'Na-Diss-Water',
	    'K-Diss-Water',
	    'Ca-Diss-Water', 
	    'Mg-Diss-Water', 
	    'pH-Diss-Water', 
	    'EC-Phys-Water', 
	    'Cl-Diss-Water',
	    'SO4-Diss-Water', 
	    'TAL-Diss-Water', 
	    'F-Diss-Water', 
	    'PO4-P-Diss-Water', 
	    'NH4-N-Diss-Water',
	    'NO3+NO2-N-Diss-Water', 
	    'Si-Diss-Water', 
	    'KJEL N-Tot-Water',
	    'P-Tot-Water', 
	    'DMS-Tot-Water',
	    'B-Diss-Water');

sub dump_header {
    print OUTF "FEATUREID| DESCRIPTION|DR| YYYY-DD-DD| HH:MM:SS";
#       Note that | must not be escaped here.
#   print OUTF join ("|", (keys %wmrq));
    foreach (@wmrq) {
	print OUTF "| " . $_;
    }
    print OUTF "|   FLOW|  MEET| DEPTH|  PRESERVE\n";
}

sub dump_record {
    #print "debug: featureid " . $featureid . "\n";
    if (defined ($featureid) && ($featureid > 0)) {
	print ERRF "Dumping $sampleid, $featureid, $date, $time\n";
#       STATION, REGION, DATE, TIME
#       I don't have station or secondary dr. region, so ...
	print OUTF "$featureid| $description| $region| $date| $time";
#       Note that | must not be escaped here.

#	print OUTF join ("|", (values %wmrq)); //this does NOT work
#       values HASH: Returns a list consisting of all the values of the named hash. 
#           The values are returned in an apparently random order!!!!!!!!!!
	foreach (@wmrq) {
	    print OUTF "| " . $wmrq{$_};
	}
#       FLOW, MEETPLAAT, DEPTH, PRESERVATIVE
	print OUTF "| -99999| -9999| ";
	print OUTF $enddepth . "| $preserve\n";
	$featureid = -9999;
	$description = -9999;
	#$sampleid = -9999;
	$region = '';
	$date = '9999-99-99';
	$time = '99:99';
	$preserve = '';
	foreach (keys %wmrq) {
	    $wmrq{$_} = -9999;
	}
    }
}

$sampleid = -1;
$featureid = -9999;
$description = -9999;
$sampleid = -9999;
$region = '';
$date = '9999-99-99';
$time = '99:99';
$preserve = '';

dump_header;
LINE : while () {
    chomp;
    #a backslash just before a delimiter and you have a problem
    $_ =~ s/\\//g;
    #eatwhite; does not work in Windows
    next LINE if (/^[ ]*$/);
    if (defined($sampleid)) {
	$oldid = $sampleid;
    }
    #else keep previous (defined) oldid
    $sampleid = (split/$delimiter/)[5];
    if (!defined($sampleid)) {
	print ERRF "Undefined sampleid, skip line $_\n";
	next LINE ;
    }
    if ($sampleid == $oldid) { 
#       still same record, so read in only changed values.
	($name, $value) = (split/$delimiter/)[13, 14];
	$name = "gaga" if (!defined ($name));
	$value = -9999 if (!defined ($value));
    } else { #new sample id
	print ERRF "Sample ID change from $oldid to $sampleid ... NEW  RECORD\n";
	dump_record;	# remember that this reset sampleid
#       read new record
	($featureid, $description, $region, $sampleid, $date, $time, $enddepth, $preserve, $name, $value) 	    
	    = (split /$delimiter/)[0, 1, 4, 5, 6, 7, 11, 12, 13, 14];
	$name = "gaga" if (!defined ($name));
	$value = -9999 if (!defined ($value));
    }
#   NB. If $name does not exist $wmrq{$name} = $value will create it!
    if (defined ($wmrq{$name})) {
	if (defined($value)) {
	    print ERRF "SUCCESS: $name = $value\n";
	    $wmrq{$name} = $value; 
	} else {
	    print ERRF "ignoring $name ---> UNDEFINED VALUE\n";
	} 
    } else {
	    print ERRF "ignoring $name ---> $value\n";
    }
}
dump_record;
print "Bye";


[IWQS Home]