From PTAGISWiki
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
use strict;
use warnings;
use LWP::Simple;
use HTML::Entities;
use CGI;
use CGI::Ajax;
my $cgi = CGI->new();
my $ajax = CGI::Ajax->new( check_river => \&check_river);
my %display = (
A => "Acclimation pond",
B => "Bridge",
C => "Canal",
D => "Dam",
H => "Hatchery",
I => "Island",
L => "Lake",
T => "Trap or Weir",
X => "Other");
my $html;
my $huc = $cgi->param('huc');
#$huc = "17060105";
my $parent = $cgi->param('Parent');
#$parent = "wallowa%20river";
my $type = $cgi->param('LocationType');
my $fixedtype = $cgi->param('FixedLocationType');
if ($type eq "river") {
$fixedtype = undef;
}
my ($stream, @name, %longname, %llid, %length, %lat, %lon);
my (@records, $record, $name, $longname, $llid, $len, $lat, $lon);
$parent =~ s/ - .*//;
$parent =~ s/ /%20/g;
$parent =~ s/,.*//;
sub gettribs {
my $huc = shift;
my $parent = shift;
my $url = "http://query.streamnet.org/streamlookup.cfm?hucid=${huc}&streamname=$parent";
my $streamnet = get $url;
if ($streamnet =~ m/There are no streams/) {
# error condition
#print "Hey, there are no streams\n";
} else {
(@records) = split(/<\/tr>/, $streamnet);
foreach $record (@records) {
next unless ($record =~ m/<td>/ms);
($name,$longname,$llid,$len,$lat,$lon) = ($record =~ m/<td>([^<]*)/msig);
#print "Found $name<br>\n";
push @name, $name;
$longname{$name} = $longname;
$llid{$name} = $llid;
$length{$name} = $len;
$lat{$name} = $lat;
$lon{$name} = $lon;
}
}
my $_name = ref @name;
my $_longname = ref %longname;
my $_llid = ref %llid;
my $_length = ref %length;
my $_lat = ref %lat;
my $_lon = ref %lon;
return ($_name, $_longname, $_llid, $_length, $_lat, $_lon);
}
&gettribs($huc,$parent);
print $ajax->build_html( $cgi, \&main );
# print "records: @records\n";
sub main {
if ($type eq "river") {
$html = &newriver;
} else {
if ($type eq "fixed") {
if ($fixedtype eq "A" or
$fixedtype eq "B" or
$fixedtype eq "C" or
$fixedtype eq "I" or
$fixedtype eq "T" or
$fixedtype eq "O") {
$html = &newfacility;
} elsif ($fixedtype eq "D" or
$fixedtype eq "L") {
$html = &newlake;
} elsif ($fixedtype eq "H") {
$html = &newhatchery;
} else {
$html = &newerror;
}
} else {
$html = &newerror;
}
}
return $html
}
sub newriver {
my $html = <<HTML;
<html><head>
<title>Location Input Form</title>
<script type="text/javascript" src="/bindings2.js"></script>
<link rel="stylesheet" type="text/css" href="http://www.ptagis.org/ptagis/style1.css" title="default">
</head><body>
<h1> Location Input Form</h1>
<form action="ajax3.pl" method ="post">
<fieldset><legend>Step #2: New river or stream</legend>
<li>HUC is $huc</li>
<li>parent is $parent</li>
<li>type is $type</li>
<li>fixedtype is $fixedtype</li>
Select a river/stream definition from those defined by Streamnet in this HUC:
<select id="newstream" name="newstream">
<option></option>
HTML
foreach $stream (@name) {
$html .= "<option value=\"$huc:$stream\">$stream</option>\n";
}
$html .= <<HTML;
</select>
<p id="poststream"></p>
<p><input type="submit" name="submit" value="next"/></p>
HTML
return $html;
}
sub check_river {
my ( $in ) = @_;
my ($huc, $stream);
($huc, $stream) = split(":", $in);
$stream =~ s/ /%20/g;
my ($html, $key);
$html = "<h3>looking up $stream</h3>\n";
my $url = "http://query.streamnet.org/streamlookup.cfm?hucid=${huc}&streamname=$stream";
$html .= "<p>$url</p>\n";
my $streamnet = get $url;
if ($streamnet =~ m/There are no streams/) {
# error condition
#print "Hey, there are no streams\n";
} else {
(@records) = split(/<\/tr>/, $streamnet);
foreach $record (@records) {
next unless ($record =~ m/<td>/ms);
($name,$longname,$llid,$len,$lat,$lon) = ($record =~ m/<td>([^<]*)/msig);
#print "Found $name<br>\n";
push @name, $name;
$longname{$name} = $longname;
$llid{$name} = $llid;
$length{$name} = $len;
$lat{$name} = $lat;
$lon{$name} = $lon;
}
}
$html .= "<p>keys of %llid are " . keys (%llid) . "</p>\n";
foreach $key (keys (%llid)) {
$html .= "<p>key: " . $key . " => llid: " . $llid{$key} . "</p>\n";
}
$html .= "<P>The LLID for $stream is " . $llid{$stream} . "</P>\n";
$html .= "<P>The length of $stream is " . $length{$stream} . "</P>\n";
$html .= "<P>The latitude of $stream is " . $lat{$stream} . "</P>\n";
$html .= "<P>The longitude of $stream is " . $lon{$stream} . "</P>\n";
return $html;
}
sub newfacility {
my $html = <<HTML;
<html><head>
<title>Location Input Form</title>
<script type="text/javascript" src="/bindings2.js"></script>
<link rel="stylesheet" type="text/css" href="http://www.ptagis.org/ptagis/style1.css" title="default">
</head><body>
<h1> Location Input Form</h1>
<form action="ajax3.pl" method ="post">
<fieldset><legend>Step #2: New $display{$fixedtype}</legend>
<li>HUC is $huc</li>
<li>parent is $parent</li>
<li>type is $type</li>
<li>fixedtype is $fixedtype</li>
<p><input type="submit" name="submit" value="next"/></p>
HTML
return $html;
}
sub newlake {
my $html = <<HTML;
<html><head>
<title>Location Input Form</title>
<script type="text/javascript" src="/bindings2.js"></script>
<link rel="stylesheet" type="text/css" href="http://www.ptagis.org/ptagis/style1.css" title="default">
</head><body>
<h1> Location Input Form</h1>
<form action="ajax3.pl" method ="post">
<fieldset><legend>Step #2: New $display{$fixedtype}</legend>
<li>HUC is $huc</li>
<li>parent is $parent</li>
<li>type is $type</li>
<li>fixedtype is $fixedtype</li>
<p><input type="submit" name="submit" value="next"/></p>
HTML
return $html;
}
sub newhatchery {
my $html = <<HTML;
<html><head>
<title>Location Input Form</title>
<script type="text/javascript" src="/bindings2.js"></script>
<link rel="stylesheet" type="text/css" href="http://www.ptagis.org/ptagis/style1.css" title="default">
</head><body>
<h1> Location Input Form</h1>
<form action="ajax3.pl" method ="post">
<fieldset><legend>Step #2: New $display{$fixedtype}</legend>
<li>HUC is $huc</li>
<li>parent is $parent</li>
<li>type is $type</li>
<li>fixedtype is $fixedtype</li>
<p><input type="submit" name="submit" value="next"/></p>
HTML
return $html;
}
sub newerror {
my $html = <<HTML;
<html><head>
<title>Location Input Form</title>
<script type="text/javascript" src="/bindings2.js"></script>
<link rel="stylesheet" type="text/css" href="http://www.ptagis.org/ptagis/style1.css" title="default">
</head><body>
<h1> Location Input Form</h1>
<form action="ajax3.pl" method ="post">
<fieldset><legend>Step #2: New $display{$fixedtype}</legend>
<li>HUC is $huc</li>
<li>parent is $parent</li>
<li>type is $type</li>
<li>fixedtype is $fixedtype</li>
<p><input type="submit" name="submit" value="next"/></p>
HTML
return $html;
}
</html></pre>
