CVS Update: fgo.ca

[Dan Brosemer <odin@cleannorth.org>]

Log Message:
-----------
Initial add.  No web logic yet just parses a zip full of xls files.

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

Revision Data
-------------
--- /dev/null
+++ public_html/butternut.pl
@@ -0,0 +1,414 @@
+#!/usr/bin/perl -w
+
+use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
+use Spreadsheet::ParseExcel::Simple;
+use Data::Dump;
+use strict;
+
+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)
+	{
+		die 'read error';
+	};
+
+my @members = $zip->members;
+my ($fh, $tmp) = Archive::Zip::tempFile();
+close $fh;
+my @errors = ();
+
+foreach my $member (@members)
+	{
+		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);
+	};
+
+exit;
+
+sub xl2idx
+	{
+		my $xl = shift;
+		my $row = $xl;
+		my $col = $xl;
+		$col =~ s/[0-9]*$//;
+		$row =~ s/^[A-Z]*//i;
+		$row--;
+		my $a = 1;
+		my %colval = map { ( $_ => $a++ ) } split //, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+		$a = 1;
+		my $col2 = 0;
+		foreach (reverse split //, $col)
+			{
+				$col2 += $a*$colval{$_};
+				$a=$a*26;
+			};
+		$col2--;
+		return ($row, $col2);
+	};
+
+sub col2idx
+	{
+		my $col = shift;
+		return (xl2idx("${col}1"))[1];
+	};
+
+sub nontabparse
+	{
+		my $xls = Spreadsheet::ParseExcel::Simple->read(shift);
+		return undef unless $xls;
+		my @sheet = ();
+		foreach my $sheet ($xls->sheets) 
+			{
+				while ($sheet->has_data) 
+					{
+						my @data = $sheet->next_row;
+						push @sheet, \@data;
+					};
+			};
+
+		my $format = shift;
+		my %data = map { ($format->{$_} => $sheet[(xl2idx($_))[0]][(xl2idx($_))[1]]) } keys %{$format};
+		print Data::Dump::dump(%data);
+		print "\n";
+		return \%data;
+	};
+
+sub tabparse
+	{
+		my $xls = Spreadsheet::ParseExcel::Simple->read(shift);
+		return undef unless $xls;
+		my @sheet = ();
+		foreach my $sheet ($xls->sheets) 
+			{
+				while ($sheet->has_data) 
+					{
+						my @data = $sheet->next_row;
+						push @sheet, \@data;
+					};
+			};
+
+		my $format = shift;
+		my $i = $format->{'-begin'}-1;
+		my @data = ();
+		while ($sheet[$i][col2idx($format->{'-hasdata'})] ne '')
+			{
+				my %row = map { ($format->{$_} => $sheet[$i][col2idx($_)]) } grep /^[^-]/, keys %{$format};
+				$i++;
+				push @data, \%row;
+			};
+		print Data::Dump::dump(@data);
+		print "\n";
+		return \@data;
+	};
+
+sub typeof
+	{
+		my $xls = Spreadsheet::ParseExcel::Simple->read(shift);
+		my @sheet = ();
+		return undef unless $xls;
+		foreach my $sheet ($xls->sheets) 
+			{
+				while ($sheet->has_data) 
+					{
+						my @data = $sheet->next_row;
+						push @sheet, \@data;
+					};
+			};
+		
+		my $fn = shift;
+		if ($sheet[0][0] =~ m/appendix 2/i)
+			{
+				return 'appendix2';
+			}
+		elsif ($sheet[0][0] =~ m/appendix 3/i)
+			{
+				return 'appendix3';
+			}
+		elsif ($sheet[0][6] =~ m/appenxix 4/i)
+			{
+				return 'appendix4';
+			}
+		elsif ($sheet[0][0] =~ m/appendix 5/i)
+			{
+				return 'appendix5';
+			};
+		return undef;
+	};