CVS Update: fgo.ca

[Dan Brosemer <odin@cleannorth.org>]

Log Message:
-----------
Initial gleipnir trappings.  Does not yet actually do anything.

Modified Files:
--------------
    fgo.ca/public_html:
        butternut.pl

Revision Data
-------------
Index: butternut.pl
===================================================================
RCS file: /cvs/fgo.ca/public_html/butternut.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lpublic_html/butternut.pl -Lpublic_html/butternut.pl -u -r1.1 -r1.2
--- public_html/butternut.pl
+++ public_html/butternut.pl
@@ -1,307 +1,366 @@
 #!/usr/bin/perl -w
+###############################################################################
+# butternut.pl - Butternut survey data collector
+# $Id$
+#
+# Copyright (C) 2008 Daniel Brosemer <odin@svartalfheim.net>
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. The name of the author may not be used to endorse or promote products
+#    derived from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+# THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL  DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+# OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+###############################################################################
 
+use Gleipnir;
 use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
 use Spreadsheet::ParseExcel::Simple;
 use Data::Dump;
 use strict;
 
-my %appendix2 = 
-	(
-		C4 => 'plotno1',
-		D4 => 'plotno2',
-		E4 => 'plotno3',
+my $gleipnir = new Gleipnir;
+my $cgi      = $gleipnir->cgi;
 
-		H4 => 'plotname',
+unless ($gleipnir->access('any'))
+  {
+    $gleipnir->url('/auth.pl');
+    print $gleipnir->output;
+    exit;
+  };
 
-		C7 => 'day1',
-		D7 => 'day2',
-		E7 => 'month1',
-		F7 => 'month2',
-		G7 => 'year1',
-		H7 => 'year2',
-		I7 => 'year3',
-		J7 => 'year4',
+$gleipnir->sidebar('patch');
 
-		C10 => 'evaluators',
-		C12 => 'propertyowner',
+do { print $gleipnir->output; exit } if ( $gleipnir->done );
 
-		C15 => 'location1',
-		C17 => 'location2',
-		C19 => 'location3',
+$gleipnir = ShowPage( -gleipnir => $gleipnir );
 
-		E22 => 'UTM1',
-		F22 => 'UTM2',
-
-		D26 => 'easting1',
-		E26 => 'easting2',
-		F26 => 'easting3',
-		G26 => 'easting4',
-		H26 => 'easting5',
-		I26 => 'easting6',
-
-		D30 => 'northing1',
-		E30 => 'northing2',
-		F30 => 'northing3',
-		G30 => 'northing4',
-		H30 => 'northing5',
-		I30 => 'northing6',
-		J30 => 'northing7',
-
-		D33 => 'spbearing1',
-		E33 => 'spbearing2',
-		F33 => 'spbearing3',
-
-		D36 => 'spdist1',
-		E36 => 'spdist2',
-		F36 => 'spdist3',
-
-		E39 => 'spUTM1',
-		F39 => 'spUTM2',
-
-		D43 => 'speasting1',
-		E43 => 'speasting2',
-		F43 => 'speasting3',
-		G43 => 'speasting4',
-		H43 => 'speasting5',
-		I43 => 'speasting6',
-
-		D47 => 'spnorthing1',
-		E47 => 'spnorthing2',
-		F47 => 'spnorthing3',
-		G47 => 'spnorthing4',
-		H47 => 'spnorthing5',
-		I47 => 'spnorthing6',
-		J47 => 'spnorthing7',
-
-		D51 => 'tree1bearing1',
-		E51 => 'tree1bearing2',
-		F51 => 'tree1bearing3',
-
-		D54 => 'tree1distance1',
-		E54 => 'tree1distance2',
-		F54 => 'tree1distance3',
-	);
-
-my %appendix3 = 
-	(
-		C5 => 'plotno1',
-		D5 => 'plotno2',
-		E5 => 'plotno3',
-
-		I5 => 'plotname',
-
-		C8 => 'day1',
-		D8 => 'day2',
-		E8 => 'month1',
-		F8 => 'month2',
-		G8 => 'year1',
-		H8 => 'year2',
-		I8 => 'year3',
-		J8 => 'year4',
-
-		C11 => 'evaluators',
-		C13 => 'propertyowner',
-		
-		D16 => 'tree1bearing1',
-		E16 => 'tree1bearing2',
-		F16 => 'tree1bearing3',
-
-		K16 => 'tree1distance1',
-		L16 => 'tree1distance2',
-		M16 => 'tree1distance3',
-
-		E19 => 'BASbutternut',
-		G19 => 'BASother1',
-		I19 => 'BASother2',
-		K19 => 'BASother3',
-		M19 => 'BASother4',
-		O19 => 'BASother5',
-		Q19 => 'BASother6',
-
-		C21 => 'prism1',
-		C22 => 'prism2',
-
-		D23 => 'tree1-20',
-		E23 => 'tree1-21',
-		F23 => 'tree1-22',
-		G23 => 'tree1-23',
-		H23 => 'tree1-24',
-		I23 => 'tree1-25',
-		J23 => 'tree1-26',
-		K23 => 'tree1-27',
-		L23 => 'tree1-28',
-		M23 => 'tree1-29',
-		N23 => 'tree1-30',
-		O23 => 'tree1-31',
-		P23 => 'tree1-32',
-		Q23 => 'tree1-33',
-		S23 => 'tree1-recentdownedbutternut',
-
-		D25 => 'midpoint-20',
-		E25 => 'midpoint-21',
-		F25 => 'midpoint-22',
-		G25 => 'midpoint-23',
-		H25 => 'midpoint-24',
-		I25 => 'midpoint-25',
-		J25 => 'midpoint-26',
-		K25 => 'midpoint-27',
-		L25 => 'midpoint-28',
-		M25 => 'midpoint-29',
-		N25 => 'midpoint-30',
-		O25 => 'midpoint-31',
-		P25 => 'midpoint-32',
-		Q25 => 'midpoint-33',
-		S25 => 'midpoint-recentdownedbutternut',
-
-		D27 => 'lasttree-20',
-		E27 => 'lasttree-21',
-		F27 => 'lasttree-22',
-		G27 => 'lasttree-23',
-		H27 => 'lasttree-24',
-		I27 => 'lasttree-25',
-		J27 => 'lasttree-26',
-		K27 => 'lasttree-27',
-		L27 => 'lasttree-28',
-		M27 => 'lasttree-29',
-		N27 => 'lasttree-30',
-		O27 => 'lasttree-31',
-		P27 => 'lasttree-32',
-		Q27 => 'lasttree-33',
-		S27 => 'lasttree-recentdownedbutternut',
-
-		E31 => 'regeneration',
-		E33 => 'leafsample',
-		E35 => 'twigcanker',
-
-		J31 => 'remarks1',
-		H33 => 'remarks2',
-		H35 => 'remarks3',
-	);
-
-my %nontab = ( appendix2 => \%appendix2, appendix3 => \%appendix3 );
-
-my %appendix4 = 
-	(
-		-begin => 5,
-		-hasdata => 'G',
-
-		A => 'treebearing1',
-		B => 'treebearing2',
-		C => 'treebearing3',
-
-		D => 'treedistance1',
-		E => 'treedistance2',
-		F => 'treedistance3',
-
-		G => 'tree',
-
-		H => 'UTM1',
-		I => 'UTM2',
-		J => 'easting1',
-		K => 'easting2',
-		L => 'easting3',
-		M => 'easting4',
-		N => 'easting5',
-		O => 'easting6',
-		P => 'northing1',
-		Q => 'northing2',
-		R => 'northing3',
-		S => 'northing4',
-		T => 'northing5',
-		U => 'northing6',
-		V => 'northing7',
-		W => 'northing8',
-
-		X => 'DBH1',
-		Y => 'DBH2',
-		Z => 'DBH3',
-
-		AA => 'crownclass',
-		AB => 'vigor',
-		AC => 'dieback1',
-		AD => 'dieback2',
-		AE => 'dieback3',
-		AF => 'terrain',
-	);
-
-my %appendix5 =
-	(
-		-begin => 5,
-		-hasdata => 'A',
-
-		A => 'tree',
-
-		B => 'root-oozing',
-		C => 'root-perenneal',
-		D => 'root-callus',
-
-		E => 'under-oozing',
-		F => 'under-perenneal',
-		G => 'under-callus',
-
-		H => 'over-oozing',
-		I => 'over-perenneal',
-		J => 'over-callus',
-
-		K => 'crown-young',
-		L => 'crown-oozing',
-		M => 'crown-perenneal',
-		N => 'crown-callus',
-
-		O => 'healthy',
-		P => 'cankerno',
-		Q => 'girdling',
-
-		R => 'eipcormic-stump',
-		S => 'epicormic-stem',
-		T => 'epicormic-crown',
-		U => 'bark',
-
-		V => 'pests-P1',
-		W => 'pests-L1',
-		X => 'pests-P2',
-		Y => 'pests-L2',
-		Z => 'remarks',
-	);
-
-my %tab = ( appendix4 => \%appendix4, appendix5 => \%appendix5 );
+print $gleipnir->output;
+exit;
 
-my $zip = Archive::Zip->new();
-unless ($zip->read($ARGV[0]) == AZ_OK)
+sub ShowPage
 	{
-		die 'read error';
-	};
+    my %options     = @_;
+    my $gleipnir    = $options{-gleipnir};
+    my $cgi         = $gleipnir->cgi;
+    my $dbh         = $gleipnir->dbh;
 
-my @members = $zip->members;
-my ($fh, $tmp) = Archive::Zip::tempFile();
-close $fh;
-my @errors = ();
+		my $template = $gleipnir->template('butternut/upload');
+		return $gleipnir->body($template->output);
+	};
 
-foreach my $member (@members)
+sub AcceptUpload
 	{
-		next if $member->isDirectory();
-		$member->extractToFileNamed($tmp);
-		unless ($member->fileName() =~ m/\.xls/i)
+		my %appendix2 = 
+			(
+				C4 => 'plotno1',
+				D4 => 'plotno2',
+				E4 => 'plotno3',
+		
+				H4 => 'plotname',
+		
+				C7 => 'day1',
+				D7 => 'day2',
+				E7 => 'month1',
+				F7 => 'month2',
+				G7 => 'year1',
+				H7 => 'year2',
+				I7 => 'year3',
+				J7 => 'year4',
+		
+				C10 => 'evaluators',
+				C12 => 'propertyowner',
+		
+				C15 => 'location1',
+				C17 => 'location2',
+				C19 => 'location3',
+		
+				E22 => 'UTM1',
+				F22 => 'UTM2',
+		
+				D26 => 'easting1',
+				E26 => 'easting2',
+				F26 => 'easting3',
+				G26 => 'easting4',
+				H26 => 'easting5',
+				I26 => 'easting6',
+		
+				D30 => 'northing1',
+				E30 => 'northing2',
+				F30 => 'northing3',
+				G30 => 'northing4',
+				H30 => 'northing5',
+				I30 => 'northing6',
+				J30 => 'northing7',
+		
+				D33 => 'spbearing1',
+				E33 => 'spbearing2',
+				F33 => 'spbearing3',
+		
+				D36 => 'spdist1',
+				E36 => 'spdist2',
+				F36 => 'spdist3',
+		
+				E39 => 'spUTM1',
+				F39 => 'spUTM2',
+		
+				D43 => 'speasting1',
+				E43 => 'speasting2',
+				F43 => 'speasting3',
+				G43 => 'speasting4',
+				H43 => 'speasting5',
+				I43 => 'speasting6',
+		
+				D47 => 'spnorthing1',
+				E47 => 'spnorthing2',
+				F47 => 'spnorthing3',
+				G47 => 'spnorthing4',
+				H47 => 'spnorthing5',
+				I47 => 'spnorthing6',
+				J47 => 'spnorthing7',
+		
+				D51 => 'tree1bearing1',
+				E51 => 'tree1bearing2',
+				F51 => 'tree1bearing3',
+		
+				D54 => 'tree1distance1',
+				E54 => 'tree1distance2',
+				F54 => 'tree1distance3',
+			);
+		
+		my %appendix3 = 
+			(
+				C5 => 'plotno1',
+				D5 => 'plotno2',
+				E5 => 'plotno3',
+		
+				I5 => 'plotname',
+		
+				C8 => 'day1',
+				D8 => 'day2',
+				E8 => 'month1',
+				F8 => 'month2',
+				G8 => 'year1',
+				H8 => 'year2',
+				I8 => 'year3',
+				J8 => 'year4',
+		
+				C11 => 'evaluators',
+				C13 => 'propertyowner',
+				
+				D16 => 'tree1bearing1',
+				E16 => 'tree1bearing2',
+				F16 => 'tree1bearing3',
+		
+				K16 => 'tree1distance1',
+				L16 => 'tree1distance2',
+				M16 => 'tree1distance3',
+		
+				E19 => 'BASbutternut',
+				G19 => 'BASother1',
+				I19 => 'BASother2',
+				K19 => 'BASother3',
+				M19 => 'BASother4',
+				O19 => 'BASother5',
+				Q19 => 'BASother6',
+		
+				C21 => 'prism1',
+				C22 => 'prism2',
+		
+				D23 => 'tree1-20',
+				E23 => 'tree1-21',
+				F23 => 'tree1-22',
+				G23 => 'tree1-23',
+				H23 => 'tree1-24',
+				I23 => 'tree1-25',
+				J23 => 'tree1-26',
+				K23 => 'tree1-27',
+				L23 => 'tree1-28',
+				M23 => 'tree1-29',
+				N23 => 'tree1-30',
+				O23 => 'tree1-31',
+				P23 => 'tree1-32',
+				Q23 => 'tree1-33',
+				S23 => 'tree1-recentdownedbutternut',
+		
+				D25 => 'midpoint-20',
+				E25 => 'midpoint-21',
+				F25 => 'midpoint-22',
+				G25 => 'midpoint-23',
+				H25 => 'midpoint-24',
+				I25 => 'midpoint-25',
+				J25 => 'midpoint-26',
+				K25 => 'midpoint-27',
+				L25 => 'midpoint-28',
+				M25 => 'midpoint-29',
+				N25 => 'midpoint-30',
+				O25 => 'midpoint-31',
+				P25 => 'midpoint-32',
+				Q25 => 'midpoint-33',
+				S25 => 'midpoint-recentdownedbutternut',
+		
+				D27 => 'lasttree-20',
+				E27 => 'lasttree-21',
+				F27 => 'lasttree-22',
+				G27 => 'lasttree-23',
+				H27 => 'lasttree-24',
+				I27 => 'lasttree-25',
+				J27 => 'lasttree-26',
+				K27 => 'lasttree-27',
+				L27 => 'lasttree-28',
+				M27 => 'lasttree-29',
+				N27 => 'lasttree-30',
+				O27 => 'lasttree-31',
+				P27 => 'lasttree-32',
+				Q27 => 'lasttree-33',
+				S27 => 'lasttree-recentdownedbutternut',
+		
+				E31 => 'regeneration',
+				E33 => 'leafsample',
+				E35 => 'twigcanker',
+		
+				J31 => 'remarks1',
+				H33 => 'remarks2',
+				H35 => 'remarks3',
+			);
+		
+		my %nontab = ( appendix2 => \%appendix2, appendix3 => \%appendix3 );
+		
+		my %appendix4 = 
+			(
+				-begin => 5,
+				-hasdata => 'G',
+		
+				A => 'treebearing1',
+				B => 'treebearing2',
+				C => 'treebearing3',
+		
+				D => 'treedistance1',
+				E => 'treedistance2',
+				F => 'treedistance3',
+		
+				G => 'tree',
+		
+				H => 'UTM1',
+				I => 'UTM2',
+				J => 'easting1',
+				K => 'easting2',
+				L => 'easting3',
+				M => 'easting4',
+				N => 'easting5',
+				O => 'easting6',
+				P => 'northing1',
+				Q => 'northing2',
+				R => 'northing3',
+				S => 'northing4',
+				T => 'northing5',
+				U => 'northing6',
+				V => 'northing7',
+				W => 'northing8',
+		
+				X => 'DBH1',
+				Y => 'DBH2',
+				Z => 'DBH3',
+		
+				AA => 'crownclass',
+				AB => 'vigor',
+				AC => 'dieback1',
+				AD => 'dieback2',
+				AE => 'dieback3',
+				AF => 'terrain',
+			);
+		
+		my %appendix5 =
+			(
+				-begin => 5,
+				-hasdata => 'A',
+		
+				A => 'tree',
+		
+				B => 'root-oozing',
+				C => 'root-perenneal',
+				D => 'root-callus',
+		
+				E => 'under-oozing',
+				F => 'under-perenneal',
+				G => 'under-callus',
+		
+				H => 'over-oozing',
+				I => 'over-perenneal',
+				J => 'over-callus',
+		
+				K => 'crown-young',
+				L => 'crown-oozing',
+				M => 'crown-perenneal',
+				N => 'crown-callus',
+		
+				O => 'healthy',
+				P => 'cankerno',
+				Q => 'girdling',
+		
+				R => 'eipcormic-stump',
+				S => 'epicormic-stem',
+				T => 'epicormic-crown',
+				U => 'bark',
+		
+				V => 'pests-P1',
+				W => 'pests-L1',
+				X => 'pests-P2',
+				Y => 'pests-L2',
+				Z => 'remarks',
+			);
+		
+		my %tab = ( appendix4 => \%appendix4, appendix5 => \%appendix5 );
+		
+		my $zip = Archive::Zip->new();
+		unless ($zip->read($ARGV[0]) == AZ_OK)
 			{
-				push @errors, $member->fileName()." does not look like an Excel file.";
-				unlink($tmp);
-				next;
+				die 'read error';
 			};
-		my $type = typeof($tmp, $member->fileName());
-		unless ($type)
+		
+		my @members = $zip->members;
+		my ($fh, $tmp) = Archive::Zip::tempFile();
+		close $fh;
+		my @errors = ();
+		
+		foreach my $member (@members)
 			{
-				push @errors, $member->fileName()." is not a recognized file.";
+				next if $member->isDirectory();
+				$member->extractToFileNamed($tmp);
+				unless ($member->fileName() =~ m/\.xls/i)
+					{
+						push @errors, $member->fileName()." does not look like an Excel file.";
+						unlink($tmp);
+						next;
+					};
+				my $type = typeof($tmp, $member->fileName());
+				unless ($type)
+					{
+						push @errors, $member->fileName()." is not a recognized file.";
+						unlink($tmp);
+						next;
+					};
+				print $member->fileName()." is $type\n";
+				my $data = '';
+				$data = nontabparse($tmp, $nontab{$type}) if ($nontab{$type});
+				$data = tabparse($tmp, $tab{$type}) if ($tab{$type});
 				unlink($tmp);
-				next;
 			};
-		print $member->fileName()." is $type\n";
-		my $data = '';
-		$data = nontabparse($tmp, $nontab{$type}) if ($nontab{$type});
-		$data = tabparse($tmp, $tab{$type}) if ($tab{$type});
-		unlink($tmp);
 	};
-
-exit;
 
 sub xl2idx
 	{