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);