# -*- perl -*-
#
# $Id: Zipcode.pm,v 1.4 1998/07/25 15:29:49 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/Zipcode.pm,v $
# $Author: ejb $
#

require 5.002;
use strict;

require TCPConnection;
require qutils;

package Zipcode;
my $package = "Zipcode";

sub lookup
{
    my ($street, $city, $state) = @_;
    my $status = 0;
    my @result = ();
    my $timeout = 75;
    my $maxtries = 3;
    my $tries = 0;
    my $done = 0;
    while (! $done)
    {
	$done = 1;
	my $f = sub { ($status, @result) =
			  get_zipcode($street, $city, $state) };
	&qutils::timeout($timeout, $f, []);
	if ($@)
	{
	    my $t = $@;
	    $status = -1;
	    if ($t =~ m/--timeout--/)
	    {
		@result = ("timed out after $timeout seconds");
		if (++$tries < $maxtries)
		{
		    $done = 0;
		}
	    }
	    else
	    {
		map { chomp } @result;
	    }
	}
    }
    ($status, @result);
}

sub get_zipcode
{
    my ($street, $city, $state) = @_;

    my $status = 0;
    my @result = ();

    eval
    {
	my $addr = "www.usps.gov";
	my $url = "/cgi-bin/zip4/zip4inq";
	my $port = 80;

	&fix(\$street, \$city, \$state);
	my $formdata = "company=&urbanization=" .
	    "&street=$street&city=$city&state=$state&zip=\r\n";
	my $length = length($formdata) - 1;

	my $c = new TCPConnection($addr, $port);
	$c->print("POST $url HTTP/1.0\r\n");
	$c->print("Content-Length: $length\r\n");
	$c->print("Content-Type: application/x-www-form-urlencoded\r\n");
	$c->print("\r\n");
	$c->print($formdata);

	my $st_before = 0;
	my $st_save = 1;
	my $st_after = 2;
	my $cur_state = $st_before;

	my @lines = ();
	my @data = ();
	my $line;
	while (defined ($line = $c->get()))
	{
	    $line =~ s/\r?\n//;
	    push(@lines, $line);
	}
	$c = undef;

	foreach $line (@lines)
	{
	    if ($cur_state == $st_before)
	    {
		if ($line =~ m/standardized address/)
		{
		    $cur_state = $st_save;
		}
	    }
	    elsif ($cur_state == $st_save)
	    {
		if ($line =~ m/<TABLE/)
		{
		    $cur_state = $st_after;
		}
		else
		{
		    $line =~ s/\r?\n//;
		    $line =~ s,</?br?>,,gi;
		    $line =~ s/^\s+//;
		    $line =~ s/\s+$//;
		    push(@data, $line);
		}
	    }
	    else
	    {
		# do nothing
	    }
	}

	my $zip = undef;
	if (@data)
	{
	    my $lastdata = $data[-1];
	    if ($lastdata =~ m/(\d{5}-\d{4})$/)
	    {
		$zip = $1;
	    }
	}

	if (defined $zip)
	{
	    @result = ($zip);
	}
	else
	{
	    push(@result,
		 "Can't determine zip code.  Response to POST follows:",
		 @lines);
	    $status = 2;
	}
    };
    if ($@)
    {
	$status = -1;
	@result = ($@);
	map { chomp } @result;
    }
    ($status, @result);
}

sub fix
{
    for (@_)
    {
	$$_ =~ s/ /+/g;
    }
}

1;

#
# END OF Zipcode
#