#!/usr/bin/perl -w
#
# $Id: ssn_lookup.pl,v 1.7 2003/01/13 05:28:42 jmates Exp $
#
# Copyright (c) 2000-2001, Jeremy Mates.  This script is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;			# better error reporting
use Getopt::Std;		# command line option processing

use Tie::AppendHash;		# treat hash values like arrays

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.7 $ ') =~ s/[^0-9.]//g;

my (%opts, %by_ssn, %by_state);

tie %by_ssn, 'Tie::AppendHash';
tie %by_state, 'Tie::AppendHash';

######################################################################
#
# MAIN

# parse command-line options
getopts('h?', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

# read from STDIN if no args left
chomp(@ARGV = <STDIN>) unless @ARGV;

# and flag the help text if nothing from STDIN
help() unless @ARGV;

# parse data into memory...
while(<DATA>) {
    chomp;

    # skip stuff that doesn't "look" like our data
    next unless m/[^0-9]{3}/;

    my ($numeric, $state_abbr, $description) = split "\t", $_, 3;
    
    # deal with the numeric stuff...
    $numeric =~ s/[^0-9,-]//;	# sanitize for fun
    
    # loop over , groups, if any...
    for my $group (split ',', $numeric) {
	# pull apart hypened ranges
	my ($min, $max) = split '-', $group;
	
	# see whether a range to deal with exists...
	if (defined $max) {
	    for my $number ($min .. $max) {
		$by_ssn{$number} = {
		    'state' => $state_abbr,
		    'description' => $description,
		};
	    }
	} else {
	    $by_ssn{$min} = {
		'state' => $state_abbr,
		'description' => $description,
	    };
	}
    }
}

# walk over arguments...
for (@ARGV) {
    # be lazy and pull out first 3 digits found in argument
    if (m/(\d{3})/) {
	# and lookup in by_ssn
	my $result = $by_ssn{$1};
	if (defined $result) {
	    for my $h (@$result) {
		print $1, "\t";
		print $h->{'state'} if exists $h->{'state'};
		print "\t";
		print $h->{'description'} if exists $h->{'description'};
		print "\n";
	    }
	} else {
	    print $1, "\t\terror: not in database\n";
	}
    }
}

exit;

# DBG this routine good for dumping contents of by_ssn
#while (my($k, $v) = each %by_ssn) {
#    for (@$v) {
#	print "$k => [", $_->{'state'}, "]\t", $_->{'description'}, "\n";
#    }
#}

######################################################################
#
# SUBROUTINES

# a generic help blarb
sub help {
    print <<"HELP";
Usage: $0 [opts]

This script reports social security number allocations, as described
at:  http://www.ssa.gov/foia/stateweb.html

Options for version $VERSION:
  -h/-?  Display this message

Run perldoc(1) on this script for additional documentation.

HELP
    exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

ssn_lookup.pl - a script to show social security number allocations.

=head1 SYNOPSIS

Simply supply the first three digits of a SSN:

  $ ssn_lookup.pl 000

=head1 DESCRIPTION

ssn_lookup.pl is a databasification of the information presented at
the ssa.gov website into an easy-to-call perl script:

http://www.ssa.gov/foia/stateweb.html

=head1 USAGE

  $ ssn_lookup.pl [OPTIONS] SSN [SSN1 .. SSNN]

Multiple SSN fragments can be specified, and will be read in from
STDIN if the command line is found to be lacking.  The script will do
its best to extract SSN's from varied data, as really only the first
three digits are needed.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=back

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 TODO

Implement by_state feature to lookup SSN from state identifiers.

Means of checking website for more-recent-than-certain date to alert
script of updates?

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2000-2001, Jeremy Mates.  This script is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 VERSION

$Id: ssn_lookup.pl,v 1.7 2003/01/13 05:28:42 jmates Exp $

=cut

# store SSN information inside the script down here...
#
# format is simple, three bits of data separated by tabs:
# numeric_range   state_abbr   description
#
# Leave state_abbr empty if not applicable.  numeric_range consits
# of three-digit numbers, with -'s to denote ranges and ,'s to denote
# series of numbers or ranges.
__DATA__
000		Invalid SSN
001-003	NH	New Hampshire
004-007	ME	Maine
008-009	VT	Vermont
010-034	MA	Massachusetts
035-039	RI	Rhode Island
040-049	CT	Connecticut
050-134	NY	New York
135-158	NJ	New Jersey
159-211	PA	Pennsylvania
212-220	MD	Maryland
221-222	DE	Delaware
223-231	VA	Virginia
691-699		New area allocated, but not yet issued
232-236	WV	West Virginia
232	NC	North Carolina
237-246		
681-690		New area allocated, but not yet issued
247-251	SC	South Carolina
654-658		
252-260	GA	Georgia
667-675		
261-267	FL	Florida
589-595		
268-302	OH	Ohio
303-317	IN	Indiana
318-361	IL	Illinois
362-386	MI	Michigan
387-399	WI	Wisconsin
400-407	KY	Kentucky
408-415	TN	Tennessee
756-763		New area allocated, but not yet issued
416-424	AL	Alabama
425-428	MS	Mississippi
587		
588		New area allocated, but not yet issued
752-755		New area allocated, but not yet issued
429-432	AR	Arkansas
676-679		New area allocated, but not yet issued
433-439	LA	Louisiana
659-665		New area allocated, but not yet issued
440-448	OK	Oklahoma
449-467	TX	Texas
627-645		
468-477	MN	Minnesota
478-485	IA	Iowa
486-500	MO	Missouri
501-502	ND	North Dakota
503-504	SD	South Dakota
505-508	NE	Nebraska
509-515	KS	Kansas
516-517	MT	Montana
518-519	ID	Idaho
520	WY	Wyoming
521-524	CO	Colorado
650-653		New area allocated, but not yet issued
525,585	NM	New Mexico
648-649		
526-527	AZ	Arizona
600-601		
764		
765		
528-529	UT	Utah
646-647		
530	NV	Nevada
680		
531-539	WA	Washington
540-544	OR	Oregon
545-573	CA	California
602-626		
574	AK	Alaska
575-576	HI	Hawaii
750-751		New area allocated, but not yet issued
577-579	DC	District of Columbia
580	VI	Virgin Islands
580-584	PR	Puerto Rico
596-599		
586	GU	Guam
586	AS	American Somoa
586		Philippine Islands
700-728		Railroad Board (discontinued July 1, 1963)