#!/usr/local/bin/perl

# patpurgesifext.pl
# Extract some fields from the fixed patron purge SIF file.
# Designed to be used with fixpatpurgesif.pl, since that generates multiple
# records per patron, if a patron has more than 3 barcode+group occurrences.
#
# This program, as supplied, outputs certain fields. If the output does not
# suit your needs, you'll have to delve into the code.
#
# Written by Roy Zimmer, Western Michigan University Libraries

use strict;

if ($#ARGV == -1) {usage();}

my $siffile = $ARGV[0];
my $outfile = $ARGV[1];

my ($fopen, $rec, $oldpatid, $bcidx, $ctr, $recctr, $address, $patid);
my ($regdate, $patexpdate, $patprgdate, $vgerdate, $vgerupddate);
my ($circhaploccode, $instid, $ssn, $statcats, $nametype, $lastname);
my ($firstname, $midname, $title, $counters, $addrcount, $addrid);
my ($addrtype, $addrstat, $addrbegdate, $addrenddate, $addrline1);
my ($addrline2, $addrline3, $addrline4, $addrline5, $city, $state);
my ($zip, $country, $phone1, $phone2, $phone3, $phone4, $addrupddate, $note);

my (@sif, @patbc_id, @patbc, @patgroup, @bcstat, @bcmoddate, @bcoffset);

@bcoffset = (10, 66, 122);  # to get barcode+group data

$fopen = sprintf("Cannot open %s for output\n", $outfile);
open(outfile, ">$outfile") or die $fopen;

$fopen = sprintf("Cannot open %s for input\n", $siffile);
open(siffile, $siffile) or die $fopen;
@sif = <siffile>;
close(siffile);

@patbc_id = @patbc = @patgroup = @bcstat = @bcmoddate = ();
$recctr = $bcidx = 0;
$oldpatid = '0';

foreach $rec (@sif)
{
  $patid = substr($rec, 0, 10);
  print "processing record $recctr\r";

  # there will be more than 1 record per patron if there are more
  # than 3 barcode/group occurrences. in that case each record will
  # contain duplicate fields, except for the barcode/group occurrences.
  if ($patid ne $oldpatid)
  {
    if ($oldpatid ne '0')
    {
      outputrec();
      @patbc_id = @patbc = @patgroup = @bcstat = @bcmoddate = ();
      $bcidx = 0;
    }

    # the rest of the fixed segment
    # the statistical categories and counters are not populated in this extract
    $regdate        = substr($rec, 178, 10);
    $patexpdate     = substr($rec, 188, 10);
    $patprgdate     = substr($rec, 198, 10);
    $vgerdate       = substr($rec, 208, 10);
    $vgerupddate    = substr($rec, 218, 10);
    $circhaploccode = substr($rec, 228, 10);
    $instid         = substr($rec, 238, 30);
    $ssn            = substr($rec, 268, 11);
    $statcats       = substr($rec, 279, 30);   # get all 10 stat categories at once
    $nametype       = substr($rec, 309,  1);
    $lastname       = substr($rec, 310, 30);
    $firstname      = substr($rec, 340, 20);
    $midname        = substr($rec, 360, 20);
    $title          = substr($rec, 380, 10);
    $counters       = substr($rec, 390, 65);   # get all statistical counters at once
    $addrcount      = substr($rec, 455,  1);

    # get address information
    # $addroffsets: seg1: 456, seg2: 885
    # always have one address
    $address = getaddress($rec, 456);

    # if not a local address and there are 2 addresses, check the 2nd one
    if (($addrtype ne '2') and ($addrcount == 2))
      {$address = getaddress($rec, 885);}

    # is there a note?
    if (($addrcount == 1) and (length($rec) > 886))
      {$note = substr($rec, 886);}
    elsif (($addrcount == 2) and (length($rec) > 1315))
      {$note = substr($rec, 1315);}
  }   # if patid ne oldpatid

  # always get the barcode/group fields, as they may "span" records
  for ($ctr=0; $ctr<3; $ctr++)
  {
    $patbc_id[$bcidx]  = substr($rec, $bcoffset[$ctr],    10);
    $patbc[$bcidx]     = substr($rec, $bcoffset[$ctr]+10, 25);
    $patgroup[$bcidx]  = substr($rec, $bcoffset[$ctr]+35, 10);
    $bcstat[$bcidx]    = substr($rec, $bcoffset[$ctr]+45, 1);
    $bcmoddate[$bcidx] = substr($rec, $bcoffset[$ctr]+46, 10);
    $bcidx++;
  }

  $oldpatid = $patid;
  $recctr++;
}
close(outfile);


sub getaddress
{
  my ($rec, $addroffset) = @_;
  my $address;

  $addrid      = substr($rec, $addroffset,     10);
  $addrtype    = substr($rec, $addroffset+10,   1);
  $addrstat    = substr($rec, $addroffset+11,   1);
  $addrbegdate = substr($rec, $addroffset+12,  10);
  $addrenddate = substr($rec, $addroffset+22,  10);
  $addrline1   = substr($rec, $addroffset+32,  50);
  $addrline2   = substr($rec, $addroffset+82,  40);
  $addrline3   = substr($rec, $addroffset+122, 40);
  $addrline4   = substr($rec, $addroffset+162, 40);
  $addrline5   = substr($rec, $addroffset+202, 40);
  $city        = substr($rec, $addroffset+242, 40);
  $state       = substr($rec, $addroffset+282,  7);
  $zip         = substr($rec, $addroffset+289, 10);
  $country     = substr($rec, $addroffset+299, 20);
  $phone1      = substr($rec, $addroffset+319, 25);
  $phone2      = substr($rec, $addroffset+343, 25);
  $phone3      = substr($rec, $addroffset+369, 25);
  $phone4      = substr($rec, $addroffset+394, 25);
  $addrupddate = substr($rec, $addroffset+419, 10);

  $address = join '|', $addrid, $addrtype, $addrstat, $addrbegdate, $addrenddate,
                       $addrline1, $addrline2, $addrline3, $addrline4,
                       $addrline5, $city, $state, $zip, $country, $phone1,
                       $phone2, $phone3, $phone4, $addrupddate;
  return $address
}


sub outputrec
{
  my $pgout = '';

  ($addrid, $addrtype, $addrstat, $addrbegdate, $addrenddate, $addrline1,
   $addrline2, $addrline3, $addrline4, $addrline5, $city, $state, $zip,
   $country, $phone1, $phone2, $phone3, $phone4, $addrupddate) = split /\|/, $address;
  # remove trailing spaces
  $lastname  =~ s/\s+$//;
  $firstname =~ s/\s+$//;
  $midname   =~ s/\s+$//;
  $addrline1 =~ s/\s+$//;
  $addrline2 =~ s/\s+$//;
  $addrline3 =~ s/\s+$//;
  $addrline4 =~ s/\s+$//;
  $addrline5 =~ s/\s+$//;
  $city      =~ s/\s+$//;
  $state     =~ s/\s+$//;
  $zip       =~ s/\s+$//;
  $country   =~ s/\s+$//;

  # if no local address, provide "error" message
  if ($addrline1 eq '') {$addrline1 = "No local address";}

  print outfile "$lastname, $firstname $midname     Expire: $patexpdate  Purge: $patprgdate\n";

  print outfile "  Patron groups: ";
  for ($bcidx=0; $bcidx<scalar(@patgroup); $bcidx++)
  {
    $patgroup[$bcidx] =~ s/\s+$//;
    if ($patgroup[$bcidx] ne '') {$pgout .= sprintf ("$patgroup[$bcidx] | ");}
  }
  chop($pgout); chop ($pgout);
  print outfile "$pgout\n";

  print outfile "  $addrline1\n";
  if ($addrline2 ne '') {print outfile "  $addrline2\n";}
  if ($addrline3 ne '') {print outfile "  $addrline3\n";}
  if ($addrline4 ne '') {print outfile "  $addrline4\n";}
  if ($addrline5 ne '') {print outfile "  $addrline5\n";}
  print outfile "  $city, $state  $zip";
  if ($country ne '') {print outfile "    $country\n";}
  else                {print outfile "\n";}

  print outfile "\n";
}


sub usage()
{
  printf ("\nUsage: patpurgesifext.pl siffile outfile\n");
  printf ("       Reads the corrected SIF file taken from the patron purge process.\n");
  printf ("       Extracts the requested fields to outfile.\n");
  exit(0);
}