#!/usr/local/bin/pugs
#
#  highgroup.pl  2006-10-11  09:52  Mark Senn  http://www.ecn.purdue.edu/~mark
#
#  Social Security numbers are of the form $area-$group-$serial.
#  $area is a three digit number, $group is a two digit number,
#  and $serial is a four digit number.
#
#  This program reads a web page at the Social Security Administration
#  and sets the corresponding elements in a @areagroup bit vector
#  if $area$group is a legal SSN prefix.
#
#  According to
#    sed -e 's/ *#.*$//' t.pl | grep -v '^$' | wc -l
#  or
#    perl -ne 's/#.*$//; /^\s*$/ or print' t.pl | wc -l
#  this program has 39 executable lines.  Of those 20 extra are
#  associate with testing and 9 extra are used to fake the input.

## This line used to work with Perl 6:
##   require LWP::Simple;
## I don't know why it doesn't now.

## Originally I wanted to use a set to store the legal $area$group
## prefixes as an example of how to use sets.  I was unable to get
## the instructions in
##   http://www.annocpan.org/~AUTRIJUS/Perl6-Pugs-6.2.12/ext/Set/lib/Set.pm
## to work.  Instead an @areagroup bit array will be used to store
## the legal $area$group prefixes.  That will run faster anyway
## probably.
## use Set;

# Make a bit vector with indices 0 through 99999 to
# represent all possible $area$group numbers.
my bit @areagroup[^100000];

# From http://www.ssa.gov/employer/ssnweb.htm:
#   Within each area, the group number (middle two (2) digits)
#   range from 01 to 99 but are not assigned in consecutive
#   order. For administrative reasons, group numbers issued
#   first consist of the ODD numbers from 01 through 09 and then
#   EVEN numbers from 10 through 98, within each area number
#   allocated to a State. After all numbers in group 98 of a
#   particular area have been issued, the EVEN Groups 02 through
#   08 are used, followed by ODD Groups 11 through 99.
# So they are assigned in this order:
#   01--09 odd numbers
#   10--98 even numbers
#   02--08 even numbers
#   11--99 odd numbers
## If I am intrepreting
##   http://dev.perl.org/perl6/doc/design/syn/S03.html
## correctly then
##   @gissued = 1..9:by(2), 10..98:by(2), 2..8:by(2), 11..99:by(2);
## will work in the future.  In the meantime the following can be used.
my @gissued = ();
loop (my $i = 1;  $i <=  9;  $i += 2)  {  push @gissued, $i;  }
loop (   $i =10;  $i <= 98;  $i += 2)  {  push @gissued, $i;  }
loop (   $i = 2;  $i <=  8;  $i += 2)  {  push @gissued, $i;  }
loop (   $i =11;  $i <= 99;  $i += 2)  {  push @gissued, $i;  }

my $url = "http://www.ssa.gov/employer/highgroup.txt";

## This line used to work with Perl 6:
##   $_ = LWP::Simple::get($url)  or  die qq/Can't get "$url": $!./;
## I don't know why it doesn't now.
## We'll fake it by using the following.  Note this just defines
## the last group for the first 12 areas.
$_ = "
        HIGHEST GROUP ISSUED AS OF 10/02/06

the process of being issued as of the date at the top of this page.

NOTE:  INDICATES GROUP CHANGE SINCE LAST MONTH.
001 04  002 04  003 04* 004 08  005 06  006 06
007 06  008 90  009 88  010 90  011 90  012 90

";

## "print" prints nothing; "$a.print" prints $a; ".print" prints $_.
print "first output: ($_)\n";

## Originally I wanted to set the legal @areagroup prefixes using a
## grammar.  I was unable to get the instructions in
##   http://dev.perl.org/perl6/doc/design/syn/S05.html
## to work.  Instead, @areagroup will be set using Perl 6's regexes.
##
## This was a simple grammar to be used just to check that the input
## was legal.  It would need more work before it could be used to
## set @areagroup.
## grammar HighGroup  {
##     rule file { ^ <line>* $ }
##     rule line { ^^ (\N* \n) $$ }
## }
## if /<HighGroup.file>/ say "valid input";

## The "** {...}" quantifier not implemented yet---will use \d
## multiple times.  One could spread the substitute command over
## several lines like this:
##   s                      # substitute
##   :g                     # globally
##   /                      # start substitute regex
##   (\d\d\d)               # match three digits
##   <ws>+                  # match whitespace one or more times
##   (\d\d)                 # match two digits
##   \*?                    # match "*" zero or one time
##   /                      # end substitute regex, start replacement
##   {SetAreagroup $0, $1}  # execute what's in { }
##   /;                     # end replacement
## Since this is pretty straight forward I prefer to use one line:
s:g/(\d\d\d)<ws>+(\d\d)\*?/{SetAreagroup $0, $1}/;

print "second output: ($_)\n";

Test  1,  1, 1;
Test  1,  3, 1;
Test  1,  4, 1;
Test  1,  6, 0;
Test 12,  1, 1;
Test 12,  3, 1;
Test 12, 90, 1;
Test 12, 92, 0;

exit 0;

sub SetAreagroup ($area, $group)  {
    loop (my $i = 0;  $i < 100;  $i++)  {
        my $t = @gissued[$i];
        @areagroup[$area*100 + $t] = 1;
        ($group == $t)  and  last;
    }
}

sub Test ($area, $group, $expected)  {
    my $t = @areagroup[$area*100 + $group];
    my $u  = $t ?? "is     a" !! "is not a";
    my $v  =  ($t == $expected) ?? "that is correct" !! "THAT IS WRONG";
    ## Normally I'd use printf to print the results:
    ##     printf "%3d %2d $u legal areagroup - $v", $area, $group;
    ## Since printf is apparently not implemented yet I'll do
    my $w = sprintf "%3d %2d $u legal areagroup - $v", $area, $group;
    say $w;
}