Home Contact
Validate the HTML of this page

ldump.pl

source code


#!/usr/local/bin/perl

#############################################################
#
#  Perl script: ldump.pl (LDAP => Patron SIF)
#      Version: 0.9.5
#
#  2005-2006, Michael Doran, doran@uta.edu
#  University of Texas at Arlington
#
#  Requires these Perl modules:
#       Net::LDAP
#       Date::Calc
#
#  This script queries the CEDAR/LDAP directory and downloads
#  info on active patrons (students & employees) for massaging
#  into the Voyager Patron SIF format.  The SIF file, in turn
#  is loaded into Voyager with the Pptrnupdt batch job.

use strict;
#use warnings;
#use diagnostics;

my $this_script = $0;
my $base_dir    = "/m1/incoming/patronload";

#  The patron record expiration date and purge date are set
#  at time of record load.  They are calculated by adding a
#  set amount of days to the date of the patron dump.

my $expire_days            = "90";
my $expire_temp_addr_days  = "7";  # temporary physical addresses
my $expire_email_addr_days = "7";  # email addresses

#############################################################
#  Files
#############################################################

# This Patron SIF db file must be available
my $patron_sif_format_db    = "$base_dir/sif.db";

# File rootname
my $base_name = "ldump";

# This is the main output file to be used for Patron Load batchjob
my $sifout_10_digit_iid = "$base_dir/$base_name.sif";

# This is the output file for records sans a 10 digit ID 
my $sifout_08_digit_iid = "$base_dir/$base_name.8dig";

# This is the output file for malformed records 
my $malformed_records = "$base_dir/$base_name.mal";

# This is the output file to be used for "bad" records 
my $bad_records = "$base_dir/$base_name.bad";

# Session log
my $log_file = "$base_dir/$base_name.log";

# Debug file
my $debug_file = "$base_dir/$base_name.txt";

#############################################################
#  Bind credentials
#############################################################
my $bind_dn = "cn=********,cn=********,dc=uta,dc=edu";
my $bind_pw = "********

#############################################################
#
#  LDAP server variables
#
#  University of Texas at Arlington LDAP servers:
#       ldap.cedar.uta.edu  -  LDAP server load balancer
#         pi.cedar.uta.edu  -  individual LDAP server
#         xi.cedar.uta.edu  -  individual LDAP server
#
#  Connection approaches:
#  OK     : Connect to an individual LDAP server.
#  Better : Connect to a LDAP server load balancer (if your
#           campus has one).  This will distribute the load
#           among available LDAP servers and authentication
#           will succeed even if one of the individual LDAP
#           servers is unavailable.
#  Best   : Per the Net::LDAP documentation, create a list
#           (array) of LDAP servers, putting the LDAP load
#           balancing host first, followed by the individual
#           LDAP servers.  Reference the array, and connect
#           to the array reference.  Each host in the list
#           will be tried in order until a connection is
#           made.  This avoids a single point of failure of
#           either an individual LDAP server *or* the LDAP
#           load balancer.

#  List (array) of LDAP servers and array reference

my @ldap_server = ('ldap.cedar.uta.edu',
                   'pi.cedar.uta.edu',
                   'xi.cedar.uta.edu');

my $rldap_server = \@ldap_server;

#############################################################
#
#  Certificate file required for TLS encryption
#  
#  If you are running Apache with SSL, you should hava a
#  ca-bundle.crt file.  Make sure that it is readable by
#  this script.

my $cert_file = "/usr/local/apache/conf/ssl.crt/ca-bundle.crt";

#############################################################
#
#  Open output files

#  Session log file
open (LOGFILE, ">$log_file")
         || die "Can't open $log_file: $!.\n";
print LOGFILE $this_script . "\t" . `date` . "\n";

#  SIF formatted records
open (SIFOUT10, ">$sifout_10_digit_iid")
         || die "Can't open $sifout_10_digit_iid: $!.\n";

#  SIF formatted records
open (SIFOUT08, ">$sifout_08_digit_iid")
         || die "Can't open $sifout_08_digit_iid: $!.\n";

#  Malformed SIF formatted records
open (MALOUT, ">$malformed_records")
         || die "Can't open $malformed_records: $!.\n";

#  Bad record log
open (BADOUT, ">$bad_records")
         || die "Can't open $bad_records: $!.\n";

#  Debug file
open (BUGOUT, ">$debug_file")
         || die "Can't open $debug_file: $!.\n";

#  Catch interrupt signals ("^C") and close down the
#  open files before quitting the script.

$SIG{INT} = \&HandleSignalInt;

&ReadSIFFile;

&DoDump;

############################################################
#  Initialize counters
############################################################

my $recs_proc = 0;  # number of records processed
my $recs_id10 = 0;  # number of utaIDs that are emplIDs
my $recs_id08 = 0;  # number of utaIDs that are CEDARIDs
my $recs_stud = 0;  # number of students
my $recs_empl = 0;  # number of employees (faculty & staff)
my $recs_ret  = 0;  # number of retirees
my $recs_dual = 0;  # number of dual student + employee
my $recs_good = 0;  # number of good records
my $recs_bad  = 0;  # number of records with errors


############################################################
#  ReadSIFFile
############################################################

my (%offset,%length,%format,%req,%name,%sprintf_format,%sprintf_fill);

sub ReadSIFFile {
    # Open the Patron SIF format DB file
    open (SIFDB, "$patron_sif_format_db")
         || die "Can't open $patron_sif_format_db: $!.\n";
    while (my $line = <SIFDB>) {
        chomp ($line);  # Remove newline character
        # If not a blank line or comment line...
        next if ($line =~ /^\s*$/ || $line =~ /^#/);
	if ($line) {
            my ($item, $offset, $length, $format, $req, $name) 
              = split(/\t/, $line);
	    if ($item && $offset && $length && $format && $req && $name) {
                $offset{"$item"} = "$offset";
                $length{"$item"} = "$length";
                $format{"$item"} = "$format";
                $req{"$item"}    = "$req";
                $name{"$item"}   = "$name";

                # Endeavor's format codes:
                # s	  string : left-justified, blank-filled
                # n  numeric : right-justififed, zero-filled
                # d     date : yyyy.mm.dd
                # b   blanks

                if ($format eq "s") {
                    # String sprintf formatting 
                    # string : left-justified, blank-filled
                    $sprintf_format{"$item"} = "%" . "-" . $length . "s"; 
                    $sprintf_fill{"$item"} = " "; 
                } elsif ($format eq "n") {
                    # Numbers sprintf formatting
                    # numeric : right-justififed, zero-filled
                    $sprintf_format{"$item"} = "%" . "0" . $length . "d"; 
                    $sprintf_fill{"$item"} = "0"; 
                } else {
                    $sprintf_format{"$item"} = "%" .       $length . "s"; 
                    $sprintf_fill{"$item"} = " "; 
                }
            } else {
                 print "Bad entry in $patron_sif_format_db" . "\n";
            }
        } 
    }
    close (SIFDB);
}


############################################################
#  DoDump
############################################################

sub DoDump {

    use Net::LDAP;

    #  Create a new Net::LDAP object and open a connection
    #  to an LDAP server.
    my $ldap = Net::LDAP->new( $rldap_server,
	version => 3,
	port    => 389,
	debug   => 0 )
        or &AuthenticationFailure("1","$@");

    #  The start_tls method converts the existing connection to
    #  Transport Layer Security (TLS), which provides encrypted
    #  traffic.  It is an alternative to using LDAPS.  
    #  The verify options are 'none', 'optional', and 'require'.
    #  The most secure option is 'require'.
    #  If you set verify to optional or require, you must also set
    #  either cafile or capath.  If you have installed Apache with
    #  SSL, you can probably use the ca-bundle.crt as your cafile
    #  file, but make sure it has the necessary read permissions.
    my $ldap_result = $ldap->start_tls(
	verify => 'require',
	cafile => "$cert_file");

    $ldap_result = $ldap->bind("$bind_dn", password => "$bind_pw");

    if ($ldap_result->code ne "0") {
        my $error_message = $ldap_result->error;
        &AuthenticationFailure("7","$error_message");
    }

    #  These values are dependent on the particular LDAP
    #  implementation.
    #  Filtering on:
    #    utaStudentStatus=enrolled
    #     "The student is enrolled in either this semester or any
    #      upcoming semester"
    #          or
    #    utaEmployeeStatus=active
    #      currently employed at UTA 
    #          or
    #    utaEmployeeStatus=retired
    #      retired UTA staff
    #          or
    #    utaEmployeeStatus=on_leave
    #      UTA staff - on sabbatical, etc
    $ldap_result = $ldap->search(
      base   => 'cn=people, dc=uta, dc=edu',
      scope  => 'subtree',
      filter => "(|(utaStudentStatus=enrolled)
                   (utaEmployeeStatus=active)
                   (utaEmployeeStatus=retired))",
      callback => \&ProcessRecord
      );
    # For debugging
    # warn $ldap_result->error if $ldap_result->code ne "0";

    $ldap->unbind();
}


############################################################
#  ProcessRecord
############################################################

sub ProcessRecord { 
     my ($mesg,$entry) = @_;
#    my $mesg = shift;
#    my $entry = shift;

#print "\$mesg is $mesg\t \$entry is $entry\n";
# $mesg is Net::LDAP::Search=HASH(0x6713a4) - always the same     
# $entry is Net::LDAP::Entry=HASH(0x72428c) - unique


    if (!$entry) {
        &Finish(0);	
    }

    $recs_proc++;

    # Initialize values
    my $surname          = "";
    my $first_name       = "";
    my $middle_name      = "";
    my $empl_id          = "";
    my $cedar_id         = "";
    my $uta_id           = "";
    my @empl_status      = "";
    my $empl_status      = "";
    my $empl_title       = "";
    my $campus_box       = "";
    my @stud_status      = "";
    my $stud_status      = "";
    my $stud_class       = "";
    my @uta_affil        = "";
    my $address_count    = "0";
    my $tmp_addr_count   = "0";
    my $address_segment  = "";
    my $email_addr       = "";
    my $home_street_1    = "";
    my $home_street_2    = "";
    my $home_city        = "";
    my $home_state       = "";
    my $home_zip         = "";
    my $home_phone       = "";
    my $stud_street_1    = "";
    my $stud_street_2    = "";
    my $stud_city        = "";
    my $stud_state       = "";
    my $stud_zip         = "";
    my $stud_phone       = "";
    my $country_code     = "";
    my $empl_phone       = "";


    $surname       = $entry->get_value('sn');
    $first_name    = $entry->get_value('givenName');
    $middle_name   = $entry->get_value('utaMiddleName');
    $empl_id       = $entry->get_value('utaEmplID');
    $cedar_id      = $entry->get_value('utaCEDARID');
    $uta_id        = $entry->get_value('utaID');
    @empl_status   = $entry->get_value('utaEmployeeStatus');
    $empl_title    = $entry->get_value("utaEmployeeTitle");
    $campus_box    = $entry->get_value("utaEmployeeCampusBox");
    @stud_status   = $entry->get_value('utaStudentStatus');
    $stud_class    = $entry->get_value('utaStudentClassification');
    @uta_affil     = $entry->get_value('utaPersonAffiliation');
    $email_addr    = $entry->get_value('utaPrimaryEmail');
    $home_phone    = $entry->get_value('homePhone');
    if ($home_phone) {
        $home_phone =~ s/\+1 //;
        $home_phone =~ s/ /\-/g;
    }
    $stud_phone    = $entry->get_value('utaStudentPhone');
    if ($stud_phone) {
        $stud_phone =~ s/\+1 //;
        $stud_phone =~ s/ /\-/g;
    }
    $empl_phone    = $entry->get_value('utaEmployeePhone');
    if ($empl_phone) {
        $empl_phone =~ s/\+1 //;
        $empl_phone =~ s/ /\-/g;
    }
    $home_street_1 = $entry->get_value('utaHomeStreet1');
    $home_street_2 = $entry->get_value('utaHomeStreet2');
    $home_city     = $entry->get_value('utaHomeCity');
    $home_state    = $entry->get_value('utaHomeState');
    $home_state    = uc($home_state);
    if ( ! length($home_state) == 2) {
        &BadRecord($uta_id,"utaHomeState not two digits");
        return;
    }
    $home_zip      = $entry->get_value('utaHomeZip');
    if (length($home_zip) == 9) {
        $home_zip = substr($home_zip,0,5) . "-" . substr($home_zip,5,4);
    }
    $stud_street_1 = $entry->get_value('utaStudentHomeStreet1');
    $stud_street_2 = $entry->get_value('utaStudentHomeStreet2');
    $stud_city     = $entry->get_value('utaStudentHomeCity');
    $stud_state    = $entry->get_value('utaStudentHomeState');
    $stud_state    = uc($stud_state);
    if ( ! length($stud_state) == 2) {
        &BadRecord($uta_id,"utaStudentHomeState not two digits");
        return;
    }
    $stud_zip      = $entry->get_value('utaStudentHomeZip');
    if (length($stud_zip) == 9) {
        $stud_zip = substr($stud_zip,0,5) . "-" . substr($stud_zip,5,4);
    }
    $country_code = "US";

    # looking for characters outside the ASCII range 
    if ($surname =~ /[\x80-\xff]/) { 
        print BUGOUT "non-ASCII" . "\t" . $uta_id . "\t" . $surname . "\n";
    } elsif ($first_name =~ /[\x80-\xff]/) {
        print BUGOUT "non-ASCII" . "\t" . $uta_id . "\t" . $first_name . "\n";
    }

    foreach my $i (@stud_status) {
        if ($i eq "enrolled") {
	    $stud_status = "enrolled";
        }
    }

    foreach my $i (@empl_status) {
        if ($i eq "retired") {
	    $empl_status = "retired";
        }
    }

    foreach my $i (@empl_status) {
        if ($i eq "active") {
	    $empl_status = "active";
        }
    }

    foreach my $i (@empl_status) {
        if ($i eq "on_leave") {
	    $empl_status = "on_leave";
        }
    }

    if (($stud_status eq "enrolled") && 
        ($empl_status eq "active")) {
        $recs_dual++;
        $recs_stud++;
        $recs_empl++;
    } elsif ($stud_status eq "enrolled") {
        $recs_stud++;
    } elsif ($empl_status eq "active" || $empl_status eq "on_leave") {
        $recs_empl++;
    } elsif ($empl_status eq "retired") {
        $recs_ret++;
    } else {
        &BadRecord($uta_id,"Unknown patron status");
        return;
    }

    #################################################
    # Patron Record Standard Interface File (SIF)
    #
    # relevant items
    #
    # Item 
    #  03   $patron_barcode	patron barcode 1	

    my $patron_barcode = $uta_id;

    #  04   $patron_group	patron group 1

    my $patron_group = "";
    if ($stud_status eq "enrolled" && $stud_class) {
        if ($stud_class =~ /freshman/i  ||
            $stud_class =~ /sophomore/i ||
            $stud_class =~ /junior/i    ||
            $stud_class =~ /senior/i    ||
            $stud_class =~ /degreed/i ) {
            $patron_group = "und";
            foreach my $i (@stud_status) {
                if ($i eq "honors") {
	            $patron_group = "honors";
                }
            }
        } elsif ($stud_class =~ /masters/i ||
            $stud_class =~ /doctoral/i     ||
            $stud_class =~ /graduate/i) {
            $patron_group = "grad";
            $expire_days  = "180";
        } else {
            &BadRecord($uta_id,"Unknown student classification");
            return;
        }
    # Note: utaStudentClassification is not a required attribute
    # so this should catch records with a valid utaStudentStatus
    # who lack a classification
    } elsif ($stud_status eq "enrolled") {
        $patron_group = "und";
    }

    if (lc($empl_status) eq "active" || lc($empl_status) eq "on_leave") {
        if (! $patron_group) {
            $patron_group = "staff";
        }
            #                       eduPerson  utaPersonAffiliation      
            # --------------------  ---------  --------------------     
            # faculty               employee   employee
            #                       faculty    faculty
            # --------------------  ---------  --------------------     
            # administrative        employee   employee      
            #                       staff      staff 
            #                                  administrative 
            # --------------------  ---------  --------------------     
            # classified            employee   employee     
            #                       staff      staff 
            #                                  classified
            # --------------------  ---------  --------------------     
            # librarian             employee   employee      
            #                       staff      staff 
            #                                  librarian
            # --------------------  ---------  --------------------     
            # extension instructor  TBD        TBD
            # --------------------  ---------  --------------------     
            # assistant instructor  employee   employee
            #                       faculty    faculty
            #                                  assistant_instructor
            # --------------------  ---------  --------------------     
            # teaching assistant    employee   employee
            #                       staff      staff
            #                                  teaching_assistant
            # --------------------  ---------  --------------------     
            # student academic      employee   employee
            #                       staff      staff
            #                                  research_assistant
            # --------------------  ---------  --------------------     
	foreach my $affil (@uta_affil) {
            if (($affil =~ /faculty/i)   || 
                ($affil =~ /admin/i)     ||
                ($affil =~ /assistant/i) ||
                ($affil =~ /librarian/i)) {
                $patron_group = "fac";
                $expire_days  = "400";
            }
        }
    }
    
    if (! $patron_group) {
        if (lc($empl_status) eq "retired") {
            $patron_group = "retfac";
        } else {
            &BadRecord($uta_id,"No patron group assigned");
            return;
        }
    }

    #  18   $expire_date	patron expiration date

    my $expire_date = &TodaysDatePlus($expire_days);

    #  19   $purge_date		patron purge date

    my $purge_days  = $expire_days + 180;
    my $purge_date  = &TodaysDatePlus($purge_days);

    if ($expire_date eq "" || $purge_date eq "" ) {
        &BadRecord($uta_id,"Bad expire or purge date");
        return;
    }

    #  23    $iid		institution ID

    my $iid = $uta_id;

    #  24    $ssn		ssn
    #  35    $name_type		name type

    my $name_type = "1";  # 1 => Personal name ; 2 => Institutional

    #  36   $surname		surname
    
    if (! $surname) {
        &BadRecord($uta_id,"Missing surname attribute");
        return;
    }

    #  37   $first_name		first name
    #  38   $middle_name	middle name

    #  52    $address_count	address count

    if ($home_street_1 && $home_city && $home_state && $home_zip) {
	my $address_type = "1";  # 1 => permanent 
        $address_count++;
        $address_segment = &AddressSegment(
                                $uta_id, 
                                $address_type,
                                $home_street_1, 
                                $home_street_2, 
                                $home_city, 
                                $home_state,
                                $home_zip,
                                $country_code,
                                $home_phone,
                                '',
                                '');
    }

    if ($stud_street_1 && $stud_city && $stud_state && $stud_zip) {
        if ($address_count < 1) {
	    my $address_type = "1";  # 1 => permanent 
            $address_count++;
            $address_segment = &AddressSegment(
                                $uta_id, 
                                $address_type,
                                $stud_street_1, 
                                $stud_street_2, 
                                $stud_city, 
                                $stud_state,
                                $stud_zip,
                                $country_code,
                                $home_phone,
                                '',
                                $stud_phone);
        } elsif ($stud_street_1 !~ /$home_street_1/i) {
	    my $address_type = "2";  # 2 => temporary 
            $address_count++;
            $tmp_addr_count++;
            $address_segment .= &AddressSegment(
                                $uta_id, 
                                $address_type,
                                $stud_street_1, 
                                $stud_street_2, 
                                $stud_city, 
                                $stud_state,
                                $stud_zip,
                                $country_code,
                                $stud_phone,
                                '',
                                '');
        }
    }

# Decision to not include campus box number addresses
#    if ($campus_box && $tmp_addr_count < 1) {
#	    my $address_type = "2";  # 2 => temporary 
#            $campus_box = "Box " . $campus_box;
#            $address_count++;
#            $address_segment .= &AddressSegment(
#                                $uta_id, 
#                                $address_type,
#                                $campus_box, 
#                                '', 
#                                '', 
#                                '',
#                                '',
#                                '',
#                                $empl_phone,
#                                '',
#                                '');
#    }

    if ($email_addr) {
	    my $address_type = "3";  # 3 => e-mail 
            $address_count++;
            $address_segment .= &AddressSegment(
                                $uta_id, 
                                $address_type,
                                $email_addr, 
                                '', 
                                '', 
                                '',
                                '',
                                '',
                                '',
                                '',
                                '');
    }

    &CreateRecord($patron_barcode, $patron_group, $expire_date, $purge_date, 
        $iid, $name_type, $surname, $first_name, $middle_name,
        $address_count, $address_segment);

    # Very important -- this reduces memory usage for LDAP searches
    # returning large results, such as this dump for patron load
    $mesg->pop_entry;

}


############################################################
#  CreateRecord
############################################################

sub CreateRecord {
    my ($patron_barcode, $patron_group, $expire_date, $purge_date, 
        $iid, $name_type, $surname, $first_name, $middle_name,
        $address_count, $address_segment) = @_;

    # Patron SIF formatting: 
    # s  string    left-justified, blank-filled
    # n  numeric   right-justified, zero-filled
    # n+ numeric   blank-filled if no data
    # d  date      YYYY.MM.DD
    # b  blanks

    my $i_01  = sprintf("$sprintf_format{'01'}","$sprintf_fill{'01'}");
    my $i_02  = sprintf("$sprintf_format{'02'}","$sprintf_fill{'02'}");
    my $i_03  = sprintf("$sprintf_format{'03'}",$patron_barcode);
    my $i_04  = sprintf("$sprintf_format{'04'}",$patron_group);
    my $i_05  = sprintf("$sprintf_format{'05'}","1"); # Active barcode status
    my $i_06  = sprintf("$sprintf_format{'06'}","$sprintf_fill{'06'}");
    my $i_07  = sprintf("$sprintf_format{'07'}","$sprintf_fill{'07'}");
    my $i_08  = sprintf("$sprintf_format{'08'}","$sprintf_fill{'08'}");
    my $i_09  = sprintf("$sprintf_format{'09'}","$sprintf_fill{'09'}");
    my $i_10  = sprintf("$sprintf_format{'10'}","$sprintf_fill{'10'}");
    my $i_11  = sprintf("$sprintf_format{'11'}","$sprintf_fill{'11'}");
    my $i_12  = sprintf("$sprintf_format{'12'}","$sprintf_fill{'12'}");
    my $i_13  = sprintf("$sprintf_format{'13'}","$sprintf_fill{'13'}");
    my $i_14  = sprintf("$sprintf_format{'14'}","$sprintf_fill{'14'}");
    my $i_15  = sprintf("$sprintf_format{'15'}","$sprintf_fill{'15'}");
    my $i_16  = sprintf("$sprintf_format{'16'}","$sprintf_fill{'16'}");
    my $i_17  = sprintf("$sprintf_format{'17'}","$sprintf_fill{'17'}");
    my $i_18  = sprintf("$sprintf_format{'18'}","$expire_date");
    my $i_19  = sprintf("$sprintf_format{'19'}","$purge_date");
    my $i_20  = sprintf("$sprintf_format{'20'}","$sprintf_fill{'20'}");
    my $i_21  = sprintf("$sprintf_format{'21'}","$sprintf_fill{'21'}");
    my $i_22  = sprintf("$sprintf_format{'22'}","$sprintf_fill{'22'}");
    my $i_23  = sprintf("$sprintf_format{'23'}","$iid");
    my $i_24  = sprintf("$sprintf_format{'24'}","$sprintf_fill{'24'}");
    my $i_25  = sprintf("$sprintf_format{'25'}","$sprintf_fill{'25'}");
    my $i_26  = sprintf("$sprintf_format{'26'}","$sprintf_fill{'26'}");
    my $i_27  = sprintf("$sprintf_format{'27'}","$sprintf_fill{'27'}");
    my $i_28  = sprintf("$sprintf_format{'28'}","$sprintf_fill{'28'}");
    my $i_29  = sprintf("$sprintf_format{'29'}","$sprintf_fill{'29'}");
    my $i_30  = sprintf("$sprintf_format{'30'}","$sprintf_fill{'30'}");
    my $i_31  = sprintf("$sprintf_format{'31'}","$sprintf_fill{'31'}");
    my $i_32  = sprintf("$sprintf_format{'32'}","$sprintf_fill{'32'}");
    my $i_33  = sprintf("$sprintf_format{'33'}","$sprintf_fill{'33'}");
    my $i_34  = sprintf("$sprintf_format{'34'}","$sprintf_fill{'34'}");
    my $i_35  = $name_type;
    my $i_36  = sprintf("$sprintf_format{'36'}",$surname); 
    my $i_37  = sprintf("$sprintf_format{'37'}",$first_name); 
    if (! $middle_name) {
         $middle_name = $sprintf_fill{'38'};
    }
    my $i_38  = sprintf("$sprintf_format{'38'}",$middle_name); 
    my $i_39  = sprintf("$sprintf_format{'39'}","$sprintf_fill{'39'}");
    my $i_40  = sprintf("$sprintf_format{'40'}","$sprintf_fill{'40'}");
    my $i_41  = sprintf("$sprintf_format{'41'}","$sprintf_fill{'41'}");
    my $i_42  = sprintf("$sprintf_format{'42'}","$sprintf_fill{'42'}");
    my $i_43  = sprintf("$sprintf_format{'43'}","$sprintf_fill{'43'}");
    my $i_44  = sprintf("$sprintf_format{'44'}","$sprintf_fill{'44'}");
    my $i_45  = sprintf("$sprintf_format{'45'}","$sprintf_fill{'45'}");
    my $i_46  = sprintf("$sprintf_format{'46'}","$sprintf_fill{'46'}");
    my $i_47  = sprintf("$sprintf_format{'47'}","$sprintf_fill{'47'}");
    my $i_48  = sprintf("$sprintf_format{'48'}","$sprintf_fill{'48'}");
    my $i_49  = sprintf("$sprintf_format{'49'}","$sprintf_fill{'49'}");
    my $i_50  = sprintf("$sprintf_format{'50'}","$sprintf_fill{'50'}");
    my $i_51  = sprintf("$sprintf_format{'51'}","$sprintf_fill{'51'}");
    my $i_52  = sprintf("$sprintf_format{'52'}",$address_count);

    my $base_segment = $i_01 . $i_02 . $i_03 . $i_04 . $i_05 
                     . $i_06 . $i_07 . $i_08 . $i_09 . $i_10
                     . $i_11 . $i_12 . $i_13 . $i_14 . $i_15
                     . $i_16 . $i_17 . $i_18 . $i_19 . $i_20
                     . $i_21 . $i_22 . $i_23 . $i_24 . $i_25
                     . $i_26 . $i_27 . $i_28 . $i_29 . $i_30
                     . $i_31 . $i_32 . $i_33 . $i_34 . $i_35
                     . $i_36 . $i_37 . $i_38 . $i_39 . $i_40
                     . $i_41 . $i_42 . $i_43 . $i_44 . $i_45
                     . $i_46 . $i_47 . $i_48 . $i_49 . $i_50
                     . $i_51 . $i_52;

    my $record = $base_segment. $address_segment;

    if (($address_count > 0) && (length($record) == (456 + ($address_count * 429)))) {
        if (length($iid) == 10) {
            print SIFOUT10 $record . "\n";
            $recs_good++;
            $recs_id10++;
        } elsif (length($iid) == 8) {
            print SIFOUT08 $record . "\n";
            $recs_id08++;
        } else {
            &BadRecord($iid,"Non-standard utaID");
        }
    } else {
        print MALOUT $record . "\n";
        &BadRecord($iid,"Bad output record length: see $malformed_records");
    }

}


############################################################
#  AddressSegment
############################################################

sub AddressSegment {
    my ($uta_id, $address_type, $address_line_1, $address_line_2,
        $city, $state, $zipcode, $country, $phone_primary, 
        $phone_mobile, $phone_other) = @_;
    my $address_status_code = "N";  # n => normal ; h => hold mail
    my $date_begin = &TodaysDatePlus(0);
    my $date_end   = &TodaysDatePlus($expire_days);
    if ($address_type eq '2') {
        $date_end   = &TodaysDatePlus($expire_temp_addr_days);
    } elsif ($address_type eq '3') {
        $date_end   = &TodaysDatePlus($expire_email_addr_days);
    }

    my $i_53  = sprintf("$sprintf_format{'53'}","$sprintf_fill{'53'}");
    my $i_54  = sprintf("$sprintf_format{'54'}",$address_type);
    my $i_55  = sprintf("$sprintf_format{'55'}",$address_status_code);
    my $i_56  = sprintf("$sprintf_format{'56'}",$date_begin);
    my $i_57  = sprintf("$sprintf_format{'57'}",$date_end);
    my $i_58  = sprintf("$sprintf_format{'58'}",$address_line_1);
    my $i_59  = sprintf("$sprintf_format{'59'}",$address_line_2);
    my $i_60  = sprintf("$sprintf_format{'60'}","$sprintf_fill{'60'}");
    my $i_61  = sprintf("$sprintf_format{'61'}","$sprintf_fill{'61'}");
    my $i_62  = sprintf("$sprintf_format{'62'}","$sprintf_fill{'62'}");
    my $i_63  = sprintf("$sprintf_format{'63'}",$city);
    my $i_64  = sprintf("$sprintf_format{'64'}",$state);
    my $i_65  = sprintf("$sprintf_format{'65'}",$zipcode);
    my $i_66  = sprintf("$sprintf_format{'66'}",$country);
    my $i_67  = sprintf("$sprintf_format{'67'}",$phone_primary);
    my $i_68  = sprintf("$sprintf_format{'68'}",$phone_mobile);
    my $i_69  = sprintf("$sprintf_format{'69'}","$sprintf_fill{'69'}");
    my $i_70  = sprintf("$sprintf_format{'70'}",$phone_other);
    my $i_71  = sprintf("$sprintf_format{'71'}","$sprintf_fill{'71'}");

    my $address_segment =                 $i_53 . $i_54 . $i_55
                        . $i_56 . $i_57 . $i_58 . $i_59 . $i_60
                        . $i_61 . $i_62 . $i_63 . $i_64 . $i_65
                        . $i_66 . $i_67 . $i_68 . $i_69 . $i_70
                        . $i_71;

   return($address_segment);
}

############################################################
#  BadRecord
############################################################

sub BadRecord {
    my ($uta_id, $reason) = @_;
    $recs_bad++;
    print BADOUT $uta_id . "\t" . $reason . "\n";
}


############################################################
#  AuthenticationFailure
############################################################
#
#  When called, this subroutine should be passed two
#  parameters: 1) an exit code, and 2) an error message

sub AuthenticationFailure {
    my ($exit_status, $error_message) = @_;
    # Check that the value passed as an exit
    # status makes sense (i.e. is a digit).
    if (! ($exit_status =~ /\d/) ) {
        $exit_status = 9;
    }
    `echo "$exit_status : $error_message" | /usr/bin/mailx -s "$this_script AuthFail" doran`;
    exit($exit_status);
}


############################################################
#  TodaysDatePlus
############################################################
#
#  Takes an integer as arguement and adds that many
#  days to today's date.
 
sub TodaysDatePlus {
    my ($date_offset) = @_;
    use Date::Calc qw(Add_Delta_Days check_date);
    my ($sec, $min, $hour, $mday, $mon, $year,
        $wday, $yday, $isdat) = localtime(time);
        $mon         += 1;
        $year        += 1900;
    ($year, $mon, $mday)
        = Add_Delta_Days($year, $mon, $mday, $date_offset);
        $mon           = sprintf("%02d", $mon);
        $mday          = sprintf("%02d", $mday);
    if (check_date($year, $mon, $mday)) {
        my $future_date = $year . "." . $mon . "."  . $mday;
        return($future_date);
    } else {
        return('');
    }
}

sub HandleSignalInt {
    &Finish(9);
}

&Finish(0);

sub Finish {
    my ($exit_status) = @_;
    if (! ($exit_status =~ /\d/) ) {
        $exit_status = 7;
    }
    print LOGFILE "Records processed:   " . sprintf("%6d",$recs_proc) . "\n";
    print LOGFILE "utaID is utaEmplID:  " . sprintf("%6d",$recs_id10) . "\n";
    print LOGFILE "utaID is utaCEDARID: " . sprintf("%6d",$recs_id08) . "\n";
    print LOGFILE "Number of students:  " . sprintf("%6d",$recs_stud) . "\n";
    print LOGFILE "Number of employees: " . sprintf("%6d",$recs_empl) . "\n";
    print LOGFILE "Number of retirees:  " . sprintf("%6d",$recs_ret)  . "\n";
    print LOGFILE "Number of stud/empl: " . sprintf("%6d",$recs_dual) . "\n";
    print LOGFILE "Number of good recs: " . sprintf("%6d",$recs_good) . "\n";
    print LOGFILE "Number of bad recs:  " . sprintf("%6d",$recs_bad)  . "\n";
    print LOGFILE "\n" . `date` . "\n";
    close (SIFOUT10);
    close (SIFOUT08);
    close (MALOUT);
    close (BADOUT);
    close (BUGOUT);
    close (LOGFILE);
    exit($exit_status);
#    exit 0;
}

exit(0);