[23415] in Perl-Users-Digest
Perl-Users Digest, Issue: 5633 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Oct 8 03:10:44 2003
Date: Wed, 8 Oct 2003 00:10:10 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Wed, 8 Oct 2003 Volume: 10 Number: 5633
Today's topics:
Re: Segmentation Fault - core dumped. Do I have latest (Glen Hendry)
Re: TCP Listener on Windows XP <mooseshoes@gmx.net>
Re: trying to understand a hash (Tad McClellan)
Re: <bwalton@rochester.rr.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 7 Oct 2003 23:12:10 -0700
From: ghendry@iprimus.com.au (Glen Hendry)
Subject: Re: Segmentation Fault - core dumped. Do I have latest version ?
Message-Id: <e6f27561.0310072212.6f539741@posting.google.com>
ghendry@iprimus.com.au (Glen Hendry) wrote in message news:<e6f27561.0310071808.13ee465f@posting.google.com>...
> Hi all,
>
> I am getting repeated seg faults and dumped cores on Solaris (version
> details below).
>
> The problem is difficult to trace with debug print statements and
<snip>
With the intentions of providing specificity to those contemplating
this problem, the source code is hereby included. Its largish, and is
certainly not the best coded I have ever seen, but it may be useful.
I hope no-one is grossly opposed to me posting >1500 lines of code.
Of course I dont expect anyone to read it all, but someoone might know
where excatly to look. Please feel free to <snip> the crap out of it
in any future replies. Thanks again.
--- long post follows ----
#!/usr/local/perl/bin/perl -w
##############################################################################
#
# Program Name : WU_619_SF_CNVEXT_INV_BAL.pl
# Author : Glen Hendry (QCOM)
# Description : Main script for Financials - Invoice Balances
# Return Value : TRUE - OK
# FALSE - ERROR
# Parameters In : Database Name
# Out : None
# Modifications :
# $Id: WU_619_SF_CNVEXT_INV_BAL.pl,v 1.10 2003/10/03 04:04:08 ghendry
Exp ghendry $
# $Log: WU_619_SF_CNVEXT_INV_BAL.pl,v $
# Revision 1.10 2003/10/03 04:04:08 ghendry
# 03-Oct-2003 Glen Hendry(QCom) SIR1355
#
# Revision 1.9 2003/10/02 07:34:07 ghendry
# 02-Oct-2003 Glen Hendry(QCom) CR1206
#
# Revision 1.8 2003/10/01 06:14:35 ghendry
# 01-Oct-2003 Glen Hendry(QCom) CR926
#
# Revision 1.7 2003/09/26 01:08:30 ghendry
# 26-Sep-2003 Glen Hendry(QCom) CR1187, SIR1218
#
# Revision 1.6 2003/09/24 06:03:10 ghendry
# 24-Sep-2003 Glen Hendry(QCom) SIR1161
#
# Revision 1.5 2003/09/23 23:02:30 ghendry
# 24-Sep-2003 Glen Hendry(QCom) SIR1155
#
# Revision 1.4 2003/09/17 00:31:47 coxa1
# 17-Sep-2003 Andrew Cox CONVCR948
#
# Revision 1.3 2003/09/01 00:42:34 garyk
# 01-Sep-2003 Gary Kerswell D&E Rework 218
#
# Revision 1.2 2003/08/28 01:31:04 garyk
# 28-Aug-2003 Gary Kerswell D&E Rework 197, 204, 206 & 210
#
# Revision 1.1 2003/08/22 05:46:40 ghendry
# 22-Aug-2003 Glen Hendry(QCom) ISASCONV7
#
#
###############################################################################
BEGIN {
# Include Project Library path for include packages.
push (@INC, ".");
push (@INC, "/usr/script/ISAS_Conv");
$ENV{"ISAS_MASTER_PROCESS"} = "WU_619_SF_CNVEXT";
$ENV{"ISAS_IMPORT_PROCESS"} = "ImportManager";
}
use strict;
use English;
use FileHandle;
use DBD::Ingres;
use Getopt::Long;
# Include Project Packages
use WU600_ISAS_PKG;
require "dumpvar.pl";
###################################
# Declare and Initialise Variables
###################################
STDOUT->autoflush(1);
STDERR->autoflush(1);
WriteDebug("Start of 619 Main");
# Additional Options Arguments (: implies argument value required.
$WU600::OptionDesc{"S:"} = "StudentTestFile Restrict data set on
students.";
$WU600::OptionDesc{"O:"} = "ExtOrgTestFile Restrict data set on Ext
Orgs.";
$WU600::OptionDesc{"P:"} = "FilePrefix
Restrict data file creation, only the
STD
EXTGD or EXTTPC data file is created.
Not Implemented Yet."; #TODO
# Initialise all other variables here.
my ($rv);
my ($sth);
my ($dbh);
my ($SQLStmt) = "";
my ($SQLStmt2) = "";
my ($PrevEOGD) = "";
my ($PrevEOTP) = "";
my ($PrevStudent) = "";
my (%ExtractRecord);
my ($ExtOrgTestFile) = "";
my ($StudentTestFile) = "";
my ($FileRestriction) = "";
$WU600::SelTypeOption{"PLT"} = "Pilot";
$WU600::SelTypeOption{"ENT"} = "Enterprise";
$WU600::MaxRecsPerFile = 2000; # WU619 requirement
#################################
# Test Passed in Parameters
#################################
GetOptions( "V" => \$WU600::Debug,
"S=s" => \$StudentTestFile,
"O=s" => \$ExtOrgTestFile,
"P=s" => \$FileRestriction,
"D=s" => \$WU600::DataDir,
"R=i" => \$WU600::MaxRecsPerFile) ||
&WU600::Usage ();
$WU600::FilePrefix = "MAIN";
# Ensure that mandatory arguments are passed in correctly.
&WU600::CheckUsage (@ARGV);
=pod
WriteDebug ("619: data dir = |$WU600::DataDir|");
WriteDebug ("619: test file = |$StudentTestFile|");
WriteDebug ("619: recs per file = |$WU600::MaxRecsPerFile|");
WriteDebug ("619: data file restirction = |$FileRestriction|");
WriteDebug ("619: Ext org file restriction = |$ExtOrgTestFile|");
=cut
# NOTE that this will be a fixed width format data file, not field
delimited.
# This layout exists for both the data file and the error file. Later
in the
# code when the error file is being created, 4 extra erre fields are
temporarily
# prepended to the file layout.
my (@FileLayout) = (
"emplid_ext_org_id 11 0 C M",
"abs_amount 18 2 F M",
"item_type 12 0 C M",
"accounting_date 10 0 C M",
#YYYYMMDD
"due_date 13 0 C M",
#SIR1218
"term 4 0 C M",
#SIR1218
"ref_no 15 0 C M",
"description 30 0 C M"
);
# The consolidated file layout is tab delimited. This layout exists
for both
# consolidated data file and the consolidated error file. Later in
the code
# when the error file is being created, 4 extra erre fields are
temporarily
# prepended to the file layout.
#
# The consolidated files are used for reconcilliation. Since there
are multiple
# data and error files created at each Institute, the consolidated
file will
# have a record in it for each record in every file on every Insitute.
The
# consolidated files have a different format to the normal data files.
my (@ConsFileLayout) = (
"debtor_no 10 0 C M",
"debtor_type_code 10 0 C M",
"ref_no 10 0 C M",
"trans_type_code 10 0 C M",
"trans_date 19 0 D M",
"due_date2 19 0 D M",
"description 30 0 C M",
"trans_amt 10 2 F M",
"outst_amt 10 2 F M",
"match_ref_no 10 0 C M",
"trans_status_code 1 0 C M",
"stud_fee_flag 1 0 C M",
"row_status 1 0 C M",
"sap_business_area 4 0 C M",
"college_code 3 0 C M",
"campus 5 0 C M",
"ps_emplid 11 0 C M",
"ps_ext_org_id 11 0 C M",
"item_type 12 0 C M",
"debtor_type 6 0 C M");
my ($x) = "";
my ($i) = 0;
my ($CountKey) = "";
my ($File) = "";
my (@InstCounts) = ();
my (%ExtOrgIdHash) = ();
my (%ErrorFileCount) = ();
my (%FileDescriptors) = ();
my (%StudProgKeyRefHash) = ();
my (%DataFileStats_TotalAmount) = ();
my (%DataFileStats_RecordCount) = ();
my ($FileType) = "dat"; #default file type to send data record to
my ($ERR_CODE) = "";
my ($ERR_MESSAGE) = "";
my ($CFile) = &WU600::GetControlFileName ();
my ($FD_CF) = new FileHandle ">$CFile";
# Initialise Count Hash
my (%CntlCount) = (
STD_Data => 0, # Data counts
EXTGD_Data => 0,
EXTTPC_Data => 0,
STD_Err => 0, # Error counts
EXTGD_Err => 0,
EXTTPC_Err => 0,
STD_Sum => 0, # Data amounts
EXTGD_Sum => 0,
EXTTPC_Sum => 0,
STD_eSum => 0, # Error amounts
EXTGD_eSum => 0,
EXTTPC_eSum => 0,
STD_Cnt => 0, # Distinct student counts
EXTGD_Cnt => 0,
EXTTPC_Cnt => 0
);
# This hash holds the counts and amounts for the CR1206
# extra column in the control file for the CONSolidation file
my (%CONS_Count) =(
data_students=> 0,
data_general => 0,
data_thirdparty => 0,
error_students=> 0,
error_general => 0,
error_thirdparty => 0,
total_rows_processed => 0,
data_rows_processed => 0,
data_total => 0,
error_rows_processed => 0,
error_total => 0,
distinct_thirdparty => 0,
distinct_students => 0,
distinct_general => 0,
student_data_sum => 0,
general_data_sum => 0,
thirdparty_data_sum => 0,
student_error_sum => 0,
general_error_sum => 0,
thirdparty_error_sum => 0
);
# This variable can point to either of the two FileHandles below.
my ($ConsolidatedFileDescriptor) = new FileHandle;
# Consolidated DATA file handle
$File="CONS_INV_BAL_".$WU600::ExecutionProcess."_".$WU600::RunDate."_0001.dat";
my ($ConsolidatedDatDescriptor) = new FileHandle
"+>$WU600::DataDir/$File";
# Consolidated ERROR file handle
$File="CONS_INV_BAL_".$WU600::ExecutionProcess."_".$WU600::RunDate."_0001.err";
my ($ConsolidatedErrDescriptor) = new FileHandle
"+>$WU600::DataDir/$File";
# Output Headings to Error File
unshift (@ConsFileLayout, "error_message 99 0 C M");
unshift (@ConsFileLayout, "error_code 99 0 C M");
unshift (@ConsFileLayout, "error_owner 99 0 C M");
unshift (@ConsFileLayout, "error_no 9 0 C M");
&WU600::CreateFieldArrays (@ConsFileLayout);
my ($FieldName);
foreach $FieldName (@WU600::FieldList) {
print $ConsolidatedErrDescriptor $FieldName .
$WU600::FieldSeparator;
}
print $ConsolidatedErrDescriptor $WU600::RecordSeparator;
# Unshift Error Fields from Layouts
shift (@ConsFileLayout);
shift (@ConsFileLayout);
shift (@ConsFileLayout);
shift (@ConsFileLayout);
my ($ConErrorFileCount) = 0;
# Open Database Session at command line database for Ext Org table
loadup.
$dbh = DBI->connect("DBI:Ingres:$WU600::ExportDB", "", "",
{ AutoCommit => 0, RaiseError => 0, PrintError => 0 } )
or die "Unable to connect to database $WU600::ExportDB\n";
$dbh->{ChopBlanks} = 1;
&LoadUpExtOrgFile(); # loads the ext org data file into %ExtOrgIdHash
&LoadStudProgKeyref(); # CONVCR1246 - Load STUD_PROG_KEYREF
$dbh->disconnect;
##########################################
### Loop through Institute databases ###
##########################################
my ($Inst, $DBase);
my ($DataRecordCount, $ErrorRecordCount); #CR961
my (%FileRecordCount) = ();
my (@fcl);
my (@FileList);
# Extract the Inst keys out from the Hash ordered alphabetically by
# Institute name. CR1187. This will make the control file have the
# resultant Institute columns ordered alphabetically.
foreach $Inst (sort keys %WU600::InstDBaseList) {
$DBase = $WU600::InstDBaseList{$Inst};
$DataRecordCount = 0;
$ErrorRecordCount = 0;
# If Not Running in PILOT Mode and Institute is a PILOT Institute
OR
# Running in PILOT Mode and Institute is NOT a PILOT Institute,
then
# skip this Institute.
if ( ($WU600::ExecutionProcess ne "PLT") &&
($WU600::PilotInst{$Inst}) ) {
WriteDebug("Skipping Pilot Institute $Inst");
next;
} elsif ( ($WU600::ExecutionProcess eq "PLT") &&
(!$WU600::PilotInst{$Inst}) ) {
WriteDebug("Skipping Non-Pilot Institute $Inst");
next;
}
#
# Open Database Session
$dbh = DBI->connect("DBI:Ingres:$DBase", "", "",
{ AutoCommit => 0, RaiseError => 0, PrintError => 0 } )
or die "Unable to connect to database $DBase\n";
$dbh->{ChopBlanks} = 1;
my ($InstCode) = GetInstNumericCode();
my (%InstCount) = (
Inst_Name => $Inst,
Inst_Code => $InstCode,
STD_Data => 0,
EXTGD_Data => 0,
EXTTPC_Data => 0,
STD_Err => 0,
EXTGD_Err => 0,
EXTTPC_Err => 0,
STD_Sum => 0,
EXTGD_Sum => 0,
EXTTPC_Sum => 0,
STD_eSum => 0, # Error amounts
EXTGD_eSum => 0,
EXTTPC_eSum => 0,
STD_Cnt => 0,
EXTGD_Cnt => 0,
EXTTPC_Cnt => 0
);
# This array matches the Filelist below. It holds the count of
files for
# each filetype as there is a maximum of 2000 records for each
file, and
# then the file in split into a new file and given an incremented
suffix
@fcl = (1,1,1,1,1,1,1,1,1,1,1,1);
# ------ file handling --- create a list of the files to gen at
each inst
@FileList = (
"INV_BAL_STD_" . $InstCode . "_CR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[0]) . ".dat",
"INV_BAL_STD_" . $InstCode . "_DR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[1]) . ".dat",
"INV_BAL_EXTGD_" . $InstCode . "_CR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[2]) . ".dat",
"INV_BAL_EXTGD_" . $InstCode . "_DR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[3]) . ".dat",
"INV_BAL_EXTTPC_" .$InstCode . "_CR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[4]) . ".dat",
"INV_BAL_EXTTPC_" .$InstCode . "_DR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[5]) . ".dat",
"INV_BAL_STD_" . $InstCode . "_CR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[6]) . ".err",
"INV_BAL_STD_" . $InstCode . "_DR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[7]) . ".err",
"INV_BAL_EXTGD_" . $InstCode . "_CR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[8]) . ".err",
"INV_BAL_EXTGD_" . $InstCode . "_DR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[9]) . ".err",
"INV_BAL_EXTTPC_" .$InstCode . "_CR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[10]) . ".err",
"INV_BAL_EXTTPC_" .$InstCode . "_DR_" . $WU600::RunDate . "_"
.
sprintf("%04d", $fcl[11]) . ".err"
);
# Open up all these files (and put the file handles into a hash
array
# FOR EACH INSTITUTE. Then based on the records selected, it can
be written
# to one of the hash array file handles.
%ErrorFileCount = ();
%FileDescriptors = ();
%DataFileStats_TotalAmount = ();
%DataFileStats_RecordCount = ();
foreach $File (@FileList) {
# open files for writing
$FileDescriptors{$File} = new FileHandle "+>$WU600::DataDir/$File";
$FileDescriptors{$File}->autoflush(1);
# Add control information (first 2 fields on row 1) for updation
later.
# Markers below are to be replaced with stats once they are
collected
if ($File =~ /\.dat$/) {
&PrepareNewDataFile($File);
} else {
&PrepareNewErrorFile($File);
}
$FileRecordCount{$File} = 0;
}
$WU600::CurrRecordNo = 1; # Initialise as one record has been
written.
# ------- end file creation ------------------
&LoadUpTestDataFiles(); # get, student restrictor, ext org
restrictor files.
WriteDebug ("\n---\nSelecting from Institute :$Inst\n---\n");
# This SQL creates the base temp table
&BuildUpSQL1(); # create the String 'SQLStmt'
#WriteDebug ("\nRunning SQL1.");
$rv = $dbh->do ($SQLStmt) || die $dbh->errstr; $dbh->commit;
&BuildTermKeyRefTable(); # Holds PS-Term information needed for
data files
&BuildUpSQL2(); # create string variable 'SQLStmt2'
$sth = $dbh->prepare ($SQLStmt2) || die $dbh->errstr;
$rv = $sth->execute() || die $dbh->errstr;
# Bind the names of the column from the select into the Data
Extract record
$sth->bind_columns( \( @ExtractRecord{ @{$sth->{NAME_lc} } } ));
while ($sth->fetchrow_arrayref) { #-----
$File = &LocalWriteOutRecord (\%InstCount);
# If we have exceeded the max record count for a file, close it off
# and open a new file with an incremented suffix
if (++$FileRecordCount{$File} >= $WU600::MaxRecsPerFile) {
CloseOffFileWhichHasReachedLimit($File);
ChangeFileDescriptors($File);
}
}
$sth->finish;
$dbh->commit;
$dbh->disconnect;
# close all the files for this institute before we jump on to the
next Inst
my ($Filename) = "";
foreach $Filename (@FileList) {
CloseOffFile($Filename);
}
# Add totals for Institute to Grand Totals.
foreach $CountKey (keys %InstCount) {
if ( $CountKey ne "Inst_Name" ) {
$CntlCount{$CountKey} += $InstCount{$CountKey};
}
}
# Add to our list of institute counts
push(@InstCounts, \%InstCount);
}
# Write out Total Control File.
&CreateControlFile("", %CntlCount);
WriteDebug("End of 619 Main");
exit (0);
######################
# Local sub routines #
######################
#########################################################################
# This routine is used after a file has reached its maximum record
count.
# There is an array of file descriptors and a file list which must be
# manipulated when a file reaches its maximum size.
sub ChangeFileDescriptors {
my ($File) = @ARG;
my ($NewFile) = "";
# locate which element of $FileList
my ($Temp) = "";
my ($index) = 0;
foreach $Temp (@FileList) {
if ($Temp eq $File) { last; }
++$index;
}
# Change the element to have a new 0001++ extension (filename
suffix).
# $fcl[index] is the current count of files for than filename
++$fcl[$index]; # this is the new count for the filetype
# Generate $NewFile, which will contain the newly incremented
filename.
# ie. remove "xxxx_.dat" from the name
$NewFile = substr ($File, 0, length($File)-8); # omitt "nnnn.dat"
from end
$NewFile = $NewFile .
sprintf ("%04d%s", $fcl[$index], substr($File, length($File)-4,
4));
#WriteDebug("new file -".$NewFile); WriteDebug("old file
-".$File);
# Open the new file
# Change the $FileDescriptiors array to point to new file
$FileDescriptors{$NewFile} = new FileHandle
"+>$WU600::DataDir/$NewFile";
$FileDescriptors{$NewFile}->autoflush(1);
close $FileDescriptors{$File}; # close the previous filedescriptor
undef $FileDescriptors{$File}; # undef the previous filedescriptor
# Create the file counts and header records for the closing file
if ($NewFile =~ /\.dat$/) { # only for data files
PrepareNewDataFile($NewFile);
} else {
PrepareNewErrorFile($NewFile);
}
# Change the master filelist array to have the new filename
extension
$FileList[$index] = $NewFile;
# Create and reset the record count for the newly opened file
$FileRecordCount{$NewFile} = 0;
$File = $NewFile;
}
sub CloseOffFileWhichHasReachedLimit
{
my ($File) = @ARG;
CloseOffFile($File);
}
sub CloseOffFile
{
my ($File) = @ARG;
if ($File =~ /\.dat$/) {
# update the first row of data files to write control information
seek $FileDescriptors{$File}, 0, 0; # rewind to start of date file
printf {$FileDescriptors{$File}} "%04.4d",
$DataFileStats_RecordCount{$File};
printf {$FileDescriptors{$File}} "%016.2f",
$DataFileStats_TotalAmount{$File};
}
if (defined ($FileDescriptors{$File})) {
close ($FileDescriptors{$File});
}
}
# This routine cannot be changed without checking what it affects.
sub PrepareNewDataFile # needs ARG to be open
{
my ($File) = @ARG;
print { $FileDescriptors{$File} } "CC__CA34567890123456";
$DataFileStats_TotalAmount{$File} = 0.0;
$DataFileStats_RecordCount{$File} = 0;
}
# This routine cannot be changed without checking what it affects.
sub PrepareNewErrorFile
{
my ($File) = @ARG;
$ErrorFileCount{$File} = 1; # initialise error counte
# Ouput Headings to Error File
unshift (@FileLayout, "error_message 99 0 C M");
unshift (@FileLayout, "error_code 99 0 C M");
unshift (@FileLayout, "error_owner 99 0 C M");
unshift (@FileLayout, "error_no 9 0 C M");
&WU600::CreateFieldArrays (@FileLayout);
my ($FieldName);
foreach $FieldName (@WU600::FieldList) {
print { $FileDescriptors{$File} } $FieldName .
$WU600::FieldSeparator;
}
print { $FileDescriptors{$File} } $WU600::RecordSeparator;
# Unshift Error Fields from Layouts
shift (@FileLayout);
shift (@FileLayout);
shift (@FileLayout);
shift (@FileLayout);
}
# ----------------------- LocalWriteOutRecord
-------------------------
#
# This routine writes records (sourced from the main SQL) to any one
of the
# 12 data files that can be open for each Institute. It decides which
file
# to write to based on the data selected.
#
sub LocalWriteOutRecord ($)
{
my ($Inst);
my ($InstCode);
my ($InstCountRef) = @ARG;
my ($Balance) = "";
my ($DebtType) = "";
$Inst = $InstCountRef->{Inst_Name}; #CR1187
$InstCode = $InstCountRef->{Inst_Code}; #CR1187
if ($ExtractRecord{debtor_type_code} eq "S") { # student
$DebtType = "STD";
$ExtractRecord{ps_ext_org_id} = "";
}
else { # Debtor_type_code == 'D' (for debtor)
$ExtractRecord{emplid_ext_org_id} =
$ExtOrgIdHash{$ExtractRecord{college_code},$ExtractRecord{debtor_no}};
if ( !defined ($ExtractRecord{emplid_ext_org_id}) ) {
$ExtractRecord{emplid_ext_org_id} = "";
}
$ExtractRecord{ps_ext_org_id} =
$ExtractRecord{emplid_ext_org_id};#CON
}
if ($ExtractRecord{debtor_type_code} eq "D" &&
($ExtractRecord{stud_fee_flag} eq "N" ||
$ExtractRecord{stud_fee_flag} eq " " || # some records (S and D)
blank
$ExtractRecord{stud_fee_flag} eq "")) # some records (S and D)
blank
{
$DebtType = "EXTGD";
}
if ($ExtractRecord{debtor_type_code} eq "D" &&
$ExtractRecord{stud_fee_flag} eq "Y") {
$DebtType = "EXTTPC";
}
$ExtractRecord{debtor_type} = $DebtType;
if ($ExtractRecord{trans_amt} < 0) {
$Balance="CR";
} else {
$Balance="DR";
}
if ($Balance eq "CR") {
$ExtractRecord{item_type} += 5000;
}
$ExtractRecord{item_type} = sprintf ("%012d",
$ExtractRecord{item_type});
&CheckForErrors(); # This sets the CONSFileDescriptor to erroe or
data
# x will be the name of the file the record has to be written to.
Which
# file the data record is written to depends on the content of the
data row.
$x="INV_BAL_".$DebtType."_".$InstCode."_".$Balance."_".$WU600::RunDate."_";
# need to add the file count at this point, normally 0001, but it
can change
# make the filecount match for any number, using reg expr, then
add a "."
$x .= sprintf ("%04d.", ReturnFileCount($x."....\.".$FileType));
$x .= $FileType; # add either ".dat" or ".err" to the filename
for output
# Generate control file information (counters)
if ($DebtType eq "STD") {
if ($FileType eq "dat") {
++$InstCountRef->{STD_Data};
++$CONS_Count{data_students}; # CR1206
$CONS_Count{student_data_sum} +=
$ExtractRecord{trans_amt};#CR1206
if ($PrevStudent ne $ExtractRecord{debtor_no}) {
++$InstCountRef->{STD_Cnt};
++$CONS_Count{distinct_students};
}
$PrevStudent = $ExtractRecord{debtor_no};
$InstCountRef->{STD_Sum} += $ExtractRecord{trans_amt}; #CR1187
} else {
++$CONS_Count{error_students}; # CR1206
++$InstCountRef->{STD_Err};
$InstCountRef->{STD_eSum} += $ExtractRecord{trans_amt}; #CR1187
$CONS_Count{student_error_sum}+=$ExtractRecord{trans_amt};
# CR1206
}
} elsif ($DebtType eq "EXTGD") { # General Debtor
if ($FileType eq "dat") {
++$InstCountRef->{EXTGD_Data};
++$CONS_Count{data_general}; # CR1206
$CONS_Count{general_data_sum}+=$ExtractRecord{trans_amt};
# CR1206
if ($PrevEOGD ne $ExtractRecord{emplid_ext_org_id}) {
++$InstCountRef->{EXTGD_Cnt};
++$CONS_Count{distinct_general};
}
$PrevEOGD = $ExtractRecord{emplid_ext_org_id};
$InstCountRef->{EXTGD_Sum} += $ExtractRecord{trans_amt}; #CR1187
} else {
++$InstCountRef->{EXTGD_Err};
++$CONS_Count{error_general}; # CR1206
$CONS_Count{general_error_sum}+=$ExtractRecord{trans_amt};
# CR1206
$InstCountRef->{EXTGD_eSum} += $ExtractRecord{trans_amt}; #CR1187
}
} else { # Third Party Debtor
if ($FileType eq "dat") {
++$InstCountRef->{EXTTPC_Data};
++$CONS_Count{data_thirdparty}; # CR1206
$CONS_Count{thirdparty_data_sum}+=$ExtractRecord{trans_amt};#CR1206
if ($PrevEOTP ne $ExtractRecord{emplid_ext_org_id}) {
++$InstCountRef->{EXTTPC_Cnt};
++$CONS_Count{distinct_thirdparty};
}
$PrevEOTP = $ExtractRecord{emplid_ext_org_id};
$InstCountRef->{EXTTPC_Sum} += $ExtractRecord{trans_amt}; #CR1187
} else {
++$CONS_Count{error_thirdparty}; # CR1206
++$InstCountRef->{EXTTPC_Err};
$InstCountRef->{EXTTPC_eSum} += $ExtractRecord{trans_amt};
#CR1187
$CONS_Count{thirdparty_error_sum}+=$ExtractRecord{trans_amt};#CR1206
}
}
# Write data record to the correct data file based on $x
(filename) hash
if ($FileType eq "dat") { # if data only (not err)
$WU600::FieldSeparator = "";
$WU600::ImportProcess = "ImportManager";
# update the control totals for each file
$DataFileStats_TotalAmount{$x} += $ExtractRecord{trans_amt};
++$DataFileStats_RecordCount{$x};
} else {
# err files get standard format
$WU600::FieldSeparator = "\t";
$WU600::ImportProcess = "SQL_Loader";
# add fields to the file format for extra error columns in error file
unshift (@FileLayout, "error_message 99 0 C M");
unshift (@FileLayout, "error_code 99 0 C M");
unshift (@FileLayout, "error_owner 99 0 C M");
unshift (@FileLayout, "error_no 9 0 C M");
push (@FileLayout, "debtor_no 10 0 C M"); # CR1355 Add debtor
No
unshift (@ConsFileLayout, "error_message 99 0 C M");
unshift (@ConsFileLayout, "error_code 99 0 C M");
unshift (@ConsFileLayout, "error_owner 99 0 C M");
unshift (@ConsFileLayout, "error_no 9 0 C M");
++$ConErrorFileCount; # Consolidate Error File counter
$ExtractRecord{error_no} = $ErrorFileCount{$x}++;
$ExtractRecord{error_owner} = $ExtractRecord{campus};
$ExtractRecord{error_code} = $ERR_CODE;
$ExtractRecord{error_message} = $ERR_MESSAGE;
}
&WU600::CreateFieldArrays (@FileLayout); # Layout may change in
each file
&WU600::WriteDataRecord ($FileDescriptors{$x}, %ExtractRecord);
# Write to consolidated files (both dat and err)
# Change file layout mapping and write consolidated data record to
file also
$WU600::FieldSeparator = "\t";
$WU600::ImportProcess = "SQL_Loader";
$ExtractRecord{error_no} = $ConErrorFileCount; # Change to cons
error cnt
&WU600::CreateFieldArrays (@ConsFileLayout);
&WU600::WriteDataRecord ($ConsolidatedFileDescriptor,
%ExtractRecord);
$WU600::CurrRecordNo = 1; # reset so that the package doesnt
split files
if ($FileType eq "err") { # remove four new fields (err code and
mesg etc)
pop (@FileLayout); # CR1355 Remove debtor No
for ($i = 0; $i < 4; $i++) {
shift (@FileLayout);
shift (@ConsFileLayout);
}
}
return $x;
}
sub ReturnFileCount
# This routine returns the file count for the named file (param) from
the
# fcl (file count list) in conjunction with the FileList global
variables.
{
my ($num) = 0;
my ($file) = "";
my ($param) = @ARG;
foreach $file (@FileList) {
if (substr($file, 0, length($param)) =~ /$param/) {
last;
}
++$num;
}
return $fcl[$num];
}
sub CheckForErrors () {
$ERR_CODE = "";
$ERR_MESSAGE = "";
# Outstanding amount should always be non 0
if ($ExtractRecord{trans_amt} == 0) {
$ERR_CODE = "ERR_WU619_0101";
$ERR_MESSAGE = "Item Amount must be entered";
}
=pod CR1206.2
# due date cannot be less than effective date
if ($ExtractRecord{due_date} lt $ExtractRecord{accounting_date}) {
$ERR_CODE = "ERR_WU619_0102";
$ERR_MESSAGE = "Due Date cannot be less than Effective Date";
}
=cut
# Student number is required for debtor_type 'S'
if ($ExtractRecord{debtor_type_code} eq "S" &&
$ExtractRecord{debtor_no} eq "") {
$ERR_CODE = "ERR_WU619_0103";
$ERR_MESSAGE = "EMPLID is required";
}
#if no record was returned dump record to err file.
if ($ExtractRecord{debtor_type_code} eq "D") { # student
if ($ExtractRecord{emplid_ext_org_id} eq "") {
$ERR_CODE = "ERR_WU619_0104";
$ERR_MESSAGE = "Ext Org Id is required";
}
}
# CONVCR1246 - Student must be in STUD_PROG_KEYREF
if ($ExtractRecord{debtor_type_code} eq "S") {
my ($temp) = $ExtractRecord{debtor_no};
if ( !(defined $StudProgKeyRefHash{$temp} )) {
$ERR_CODE = "ERR_WU619_0105";
$ERR_MESSAGE = "Student does not exist in STUD_PROG_KEYREF";
}
}
# This code below is required <cringe> to keep a segmentation viol
at bay
$ERR_CODE = $ERR_CODE;
$ERR_MESSAGE = $ERR_MESSAGE;
if ($ERR_CODE ne "") { # Erro has occurred, change file pointers
to error
$FileType = "err";
$ConsolidatedFileDescriptor = $ConsolidatedErrDescriptor; # write err
++$CONS_Count{error_rows_processed}; # CR1206
$CONS_Count{error_total} += $ExtractRecord{trans_amt} ; # CR1206
}
else {
$FileType = "dat";
$ConsolidatedFileDescriptor = $ConsolidatedDatDescriptor; # write dat
++$CONS_Count{data_rows_processed}; # CR1206
$CONS_Count{data_total} += $ExtractRecord{trans_amt} ; # CR1206
}
++$CONS_Count{total_rows_processed};
}
# ------------------------- LoadUpTestDataFiles
-----------------------
#
# This routine will load up data files into temporary tables for SQL
# usage.
#
sub LoadUpTestDataFiles ()
{
my ($rv);
my ($CreateStmt) = "";
# Load up the student range file (STDNT_TEST.dat into
zwu624_stud_range)
# ------------------
if ($StudentTestFile ne "") {
# create zwu624_stud_range
if (&WU600::DropTable ($dbh, "zwu619_stdnt_test", 0) > 0) {
$CreateStmt = "CREATE TABLE zwu619_stdnt_test (ps_emplid varchar(10))
";
$rv = $dbh->do ($CreateStmt) ||
&ProgramFinish (1, $dbh->errstr, "zwu619_stdnt_test");
$dbh->commit;
# Load data into student test reference Table from data file (if
exists)
if ($StudentTestFile eq "") { $StudentTestFile = "STDNT_TEST.dat"; }
if ( -f "$WU600::FilesDir/$StudentTestFile" ) {
$CreateStmt = "COPY TABLE zwu619_stdnt_test ( ps_emplid = c0nl )
FROM '$WU600::FilesDir/$StudentTestFile' ";
$rv = $dbh->do ($CreateStmt) || die $dbh->errstr;
$dbh->commit;
}
else {
$WU600::ErrFile = $ConsolidatedErrDescriptor;
&WU600::LogError ("ERR_WU619_0002", $Inst);
}
}
}
# Load up the ext org range file (EXT_ORG_TEST.dat into
zwu619_ext_org_test)
# ------------------
if ($ExtOrgTestFile ne "") {
# create zwu619_ext_org_test
if (&WU600::DropTable ($dbh, "zwu619_ext_org_test", 0) > 0) {
$CreateStmt ="CREATE TABLE zwu619_ext_org_test
(ps_ext_org_id varchar(11))";
$rv = $dbh->do ($CreateStmt) ||
&ProgramFinish (1, $dbh->errstr, "zwu619_ext_org_test");
$dbh->commit;
# Load data into student test reference Table from data file
if ($ExtOrgTestFile eq "") {
$ExtOrgTestFile = "EXT_ORG_TEST.dat";
}
if ( -f "$WU600::FilesDir/$ExtOrgTestFile" ) {
$CreateStmt = "COPY TABLE zwu619_ext_org_test " .
"(ps_ext_org_id=c0nl)
FROM '$WU600::FilesDir/$ExtOrgTestFile' ";
$rv = $dbh->do ($CreateStmt) || die $dbh->errstr;
$dbh->commit;
}
else {
$WU600::ErrFile = $ConsolidatedErrDescriptor;
&WU600::LogError ("ERR_WU619_0003", $Inst);
}
}
}
}
#-----------------------------------------------------------
sub LoadUpExtOrgFile ()
{
my ($rv);
my ($CreateStmt) = "";
my ($tempsql) = "";
my ($Result) = "";
my ($localsth);
# ensure that the EXT ORG reference file exists (KEYREF)
# -----------------
if ( -f $WU600::FilesDir . "TQ_EXT_ORG_TBL_KEYREF.dat" ) {
&WU600::DropTable ($dbh, "zwu619_ext_org_keyref", 0);
$CreateStmt = "CREATE TABLE zwu619_ext_org_keyref (
college_code varchar(3),
debtor_no varchar(10),
ext_org_id varchar(11) ) ";
$rv = $dbh->do ($CreateStmt) ||
&ProgramFinish (1, $dbh->errstr, "zwu619_ext_org_keyref");
$dbh->commit;
$CreateStmt = "COPY TABLE zwu619_ext_org_keyref (college_code =
c0tab,
debtor_no = c0tab,
ext_org_id = c0nl )
FROM '$WU600::FilesDir/TQ_EXT_ORG_TBL_KEYREF.dat' ";
$rv = $dbh->do ($CreateStmt) || die $dbh->errstr;
$dbh->commit;
}
else {
$WU600::ErrFile = $ConsolidatedErrDescriptor;
&WU600::LogError ("ERR_WU619_0001", "TAFEQ");
exit (0);
}
# Now create a global hash with the Ext Org Id values in it.
$tempsql = "SELECT ext_org_id, debtor_no, college_code
FROM zwu619_ext_org_keyref ";
$localsth = $dbh->prepare ($tempsql);
$rv = $localsth->execute ();
my ($extorgid) = 0;
my ($debtor_no) = 0;
my ($college_code) = "";
while (($extorgid, $debtor_no, $college_code) =
$localsth->fetchrow_array) {
$ExtOrgIdHash{$college_code,$debtor_no} = $extorgid;
}
$localsth->finish;
$dbh->commit;
}
sub BuildUpSQL1 ()
{
&WU600::DropTable ($dbh, "zwu619_inv_bal", 0);
# Sql start
$SQLStmt = "
CREATE TABLE zwu619_inv_bal AS
SELECT match_ref_no,
MONEY (SUM (trans_amt)) AS summed_inv_amt
FROM ard_debtor_trans a
WHERE trans_status_code = 'P'
AND debtor_no != ''
AND debtor_type_code != ''
AND row_status = 'A'
";
if ($ExtOrgTestFile ne "") {
$SQLStmt .= " AND a.debtor_no IN ( SELECT ps_ext_org_id /* debtorno
*/
FROM zwu619_ext_org_test ) \n ";
}
if ($StudentTestFile ne "") {
$SQLStmt .= " AND a.debtor_no IN ( SELECT ps_emplid
FROM zwu619_stdnt_test ) \n ";
}
$SQLStmt .= " \n\t GROUP BY match_ref_no
HAVING MONEY (SUM (trans_amt)) != 0 ";
}
sub BuildTermKeyRefTable ()
{
#
# This code is taken from ISASCONV1
#
my ($TermDataFile) = $WU600::FilesDir . "TERM_KEYREF.dat";
my ($TableAgeMax) = &WU600::FileAge ($TermDataFile);
my ($CreateStmt) = "";
# If Term File Does not exist, set Table Age Max to 1000, only create
# table if it does not exist.
if ($TableAgeMax == 0) { $TableAgeMax = 1000; }
# If Term Key Ref table newer than data file, then re-create.
if (&WU600::DropTable ($dbh, "zwu600_term_keyref", $TableAgeMax) > 0)
{
# Create Term Key reference Table
$CreateStmt = "CREATE TABLE zwu600_term_keyref (
locn_code varchar(3),
term_year varchar(4),
term varchar(4) ) ";
$rv = $dbh->do ($CreateStmt) || &ProgramFinish (1, $dbh->errstr);
$dbh->commit;
# Load data into Term Key reference Table from data file (if if
exists)
if ( -f $TermDataFile) {
$CreateStmt = "COPY TABLE zwu600_term_keyref ( locn_code =
c0tab,
term_year = c0tab, term = c0nl ) FROM '$TermDataFile'";
$rv = $dbh->do ($CreateStmt) ||
&ProgramFinish (1, $dbh->errstr, "zwu600_term_keyref");
$dbh->commit;
}
else {
$WU600::ErrFile = $ConsolidatedErrDescriptor;
&WU600::LogError ("ERR_WU600_0003", $Inst);
exit (0);
}
}
}
sub BuildUpSQL2 ()
{
# Sql start
$SQLStmt2 = "
SELECT CASE
WHEN c.college_locn_code = '020' THEN 'TNQ'
WHEN c.college_locn_code = '030' THEN 'SBI'
WHEN c.college_locn_code = '050' THEN 'GLC'
WHEN c.college_locn_code = '060' THEN 'BRM'
WHEN c.college_locn_code = '110' THEN 'MTI'
WHEN c.college_locn_code = '120' THEN 'CQI'
WHEN c.college_locn_code = '140' THEN 'SQI'
WHEN c.college_locn_code = '150' THEN 'BAR'
WHEN c.college_locn_code = '160' THEN 'YER'
WHEN c.college_locn_code = '190' THEN 'MOR'
WHEN c.college_locn_code = '210' THEN 'CSI'
WHEN c.college_locn_code = '260' THEN 'LOG'
WHEN c.college_locn_code = '300' THEN 'OLI'
WHEN c.college_locn_code = '320' THEN 'WBI'
WHEN c.college_locn_code = '400' THEN 'BNI'
ELSE ' ' END AS campus,
CASE
WHEN c.college_locn_code = '020' THEN 72400
WHEN c.college_locn_code = '030' THEN 72000
WHEN c.college_locn_code = '050' THEN 71000
WHEN c.college_locn_code = '060' THEN 70400
WHEN c.college_locn_code = '110' THEN 71600
WHEN c.college_locn_code = '120' THEN 70600
WHEN c.college_locn_code = '140' THEN 72200
WHEN c.college_locn_code = '150' THEN 70000
WHEN c.college_locn_code = '160' THEN 72800
WHEN c.college_locn_code = '190' THEN 71400
WHEN c.college_locn_code = '210' THEN 70800
WHEN c.college_locn_code = '260' THEN 71200
WHEN c.college_locn_code = '300' THEN 71800
WHEN c.college_locn_code = '320' THEN 72600
WHEN c.college_locn_code = '400' THEN 70200
ELSE 0 END AS item_type,
CASE
WHEN c.college_locn_code = '020' THEN 'X000'
WHEN c.college_locn_code = '030' THEN 'AAAA'
WHEN c.college_locn_code = '050' THEN 'P000'
WHEN c.college_locn_code = '060' THEN 'M000'
WHEN c.college_locn_code = '110' THEN 'V000'
WHEN c.college_locn_code = '120' THEN 'T000'
WHEN c.college_locn_code = '140' THEN 'N000'
WHEN c.college_locn_code = '150' THEN 'U000'
WHEN c.college_locn_code = '160' THEN 'E000'
WHEN c.college_locn_code = '190' THEN 'D000'
WHEN c.college_locn_code = '210' THEN 'R000'
WHEN c.college_locn_code = '260' THEN 'L000'
WHEN c.college_locn_code = '300' THEN 'F000'
WHEN c.college_locn_code = '320' THEN 'W000'
WHEN c.college_locn_code = '400' THEN 'H000'
ELSE ' ' END AS sap_business_area,
CASE
WHEN a.debtor_type_code = 'S' THEN a.debtor_no
ELSE '' END AS ps_emplid,
a.debtor_no,
c.college_locn_code as college_code,
a.debtor_no AS emplid_ext_org_id,
a.debtor_type_code,
a.ref_no,
a.trans_type_code,
a.trans_status_code,
a.stud_fee_flag,
a.match_ref_no,
d.term,
(RIGHT('0000'+VARCHAR(DATE_PART('YEAR', a.trans_date)), 4) +
RIGHT( '00'+VARCHAR(DATE_PART('MONTH', a.trans_date)), 2) +
RIGHT( '00'+VARCHAR(DATE_PART('DAY', a.trans_date)), 2))
AS accounting_date,
(RIGHT('0000'+VARCHAR(DATE_PART('YEAR', a.due_date)), 4) +
RIGHT( '00'+VARCHAR(DATE_PART('MONTH', a.due_date)), 2) +
RIGHT( '00'+VARCHAR(DATE_PART('DAY', a.due_date)), 2))
AS due_date,
(RIGHT('0000'+VARCHAR(DATE_PART('YEAR', a.trans_date)), 4) + '-' +
RIGHT( '00'+VARCHAR(DATE_PART('MONTH', a.trans_date)), 2) + '-' +
RIGHT( '00'+VARCHAR(DATE_PART('DAY', a.trans_date)), 2) + ' ' +
RIGHT( '00'+VARCHAR(DATE_PART('HOUR', a.trans_date)), 2) + ':' +
RIGHT( '00'+VARCHAR(DATE_PART('MINUTE',a.trans_date)), 2) + ':' +
RIGHT( '00'+VARCHAR(DATE_PART('SECOND',a.trans_date)), 2))
AS trans_date,
(RIGHT('0000'+VARCHAR(DATE_PART('YEAR', a.due_date)), 4) + '-' +
RIGHT( '00'+VARCHAR(DATE_PART('MONTH', a.due_date)), 2) + '-' +
RIGHT( '00'+VARCHAR(DATE_PART('DAY', a.due_date)), 2) + ' ' +
RIGHT( '00'+VARCHAR(DATE_PART('HOUR', a.due_date)), 2) + ':' +
RIGHT( '00'+VARCHAR(DATE_PART('MINUTE',a.due_date)), 2) + ':' +
RIGHT( '00'+VARCHAR(DATE_PART('SECOND',a.due_date)), 2))
AS due_date2,
LEFT(a.stmt_narr, 30) AS description,
a.row_status,
MONEY (a.outst_amt) AS outst_amt, /* CR1206 */
MONEY (b.summed_inv_amt) AS trans_amt, /* CR1206 */ /* total for inv
*/
MONEY (ABS(b.summed_inv_amt)) AS abs_amount
FROM ard_debtor_trans a,
zwu619_inv_bal b,
syd_ctl c,
zwu600_term_keyref d
WHERE a.ref_no = b.match_ref_no
AND c.college_locn_code = d.locn_code
AND DATE_PART('YEAR', a.trans_date) = d.term_year
ORDER BY debtor_no,
debtor_type_code,
stud_fee_flag,
match_ref_no,
trans_date ";
#WriteDebug ("619 a. inv balance selected as\n$SQLStmt2\n\n");
#WriteDebug ("\nRunning SQL2.");
}
# This local debug routine, does not put into timestamp information.
sub WriteDebug ($)
{
my ($DebugMess) = @ARG;
$DebugMess =~ s/0E0/0/;
if ($DebugMess !~ /\n$/) { $DebugMess .= "\n"; }
print STDERR $DebugMess;
return;
}
sub CreateControlFile () # See example below.
{
my ($Counts);
########
# HEADER Line 1
########
foreach $Counts ( sort @InstCounts ) {
print $FD_CF "\t". $Counts->{Inst_Name}; # Append Institute
names
}
print $FD_CF "\tTotal\tCONS_INV_BAL";
# TOTAL - Line 2
print $FD_CF "\nCount of rows processed (Total including Errors)
\t";
# CONS
print $FD_CF "$CONS_Count{total_rows_processed}\t"; # CR1206
# Each Institute
foreach $Counts ( sort @InstCounts ) {
print $FD_CF ($Counts->{STD_Data} +
$Counts->{EXTGD_Data} + $Counts->{EXTTPC_Data}
+
$Counts->{STD_Err} + $Counts->{EXTGD_Err}
+
$Counts->{EXTTPC_Err}) . "\t";
}
# Total
print $FD_CF ($CntlCount{STD_Data} + $CntlCount{EXTGD_Data} +
$CntlCount{EXTTPC_Data} + $CntlCount{STD_Err} +
$CntlCount{EXTGD_Err} + $CntlCount{EXTTPC_Err}) .
"\t";
###############
# Count of DATA
############### - Line 3
print $FD_CF "\nCount of rows written to data files in the
following " .
"categories";
# Student Debtors
print $FD_CF "\n Student Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{STD_Data} . "\t";
}
print $FD_CF "$CntlCount{STD_Data}\t";
print $FD_CF "$CONS_Count{data_students}\t"; # CR1206
# General Debtors
print $FD_CF "\n General Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTGD_Data} . "\t";
}
print $FD_CF "$CntlCount{EXTGD_Data}\t";
print $FD_CF "$CONS_Count{data_general}\t"; # CR1206
# Third party Contract Debtors
print $FD_CF "\n Third Party Contract Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTTPC_Data} . "\t";
}
print $FD_CF "$CntlCount{EXTTPC_Data}\t";
print $FD_CF "$CONS_Count{data_thirdparty}\t"; # CR1206
# Grand Total - Line 6
print $FD_CF "\nTotal \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF ($Counts->{STD_Data} +
$Counts->{EXTGD_Data} +
$Counts->{EXTTPC_Data}) . "\t";
}
print $FD_CF " " . ($CntlCount{STD_Data} +
$CntlCount{EXTGD_Data} +
$CntlCount{EXTTPC_Data}) . "\t";
print $FD_CF " ". ($CONS_Count{data_general} +
$CONS_Count{data_students} +
$CONS_Count{data_thirdparty}) . "\t";
#################
# Count of ERRORS
#################
print $FD_CF "\nCount of rows written to error files in the " .
"following categories\n";
# Student Debtors
print $FD_CF " Student Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{STD_Err} . "\t";
}
print $FD_CF "$CntlCount{STD_Err}\t";
print $FD_CF "$CONS_Count{error_students}\t"; # CR1206
# General Debtors
print $FD_CF "\n General Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTGD_Err} . "\t";
}
print $FD_CF "$CntlCount{EXTGD_Err}\t";
print $FD_CF "$CONS_Count{error_general}\t"; # CR1206
# Third party Contract Debtors
print $FD_CF "\n Third Party Contract Debtors\t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTTPC_Err} . "\t";
}
print $FD_CF "$CntlCount{EXTTPC_Err}\t";
print $FD_CF "$CONS_Count{error_thirdparty}\t"; # CR1206
# Grand Total - Line 11
print $FD_CF "\nTotal \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF ($Counts->{STD_Err} +
$Counts->{EXTGD_Err} +
$Counts->{EXTTPC_Err}) . "\t";
}
print $FD_CF " " . ($CntlCount{STD_Err} +
$CntlCount{EXTGD_Err} +
$CntlCount{EXTTPC_Err}) . "\t";
print $FD_CF " " . ($CONS_Count{error_general} +
$CONS_Count{error_students} +
$CONS_Count{error_thirdparty}) . "\t";
#############
# SUM TOTALS
#############
print $FD_CF "\nSum of outstanding amounts in the following
categories\n";
# Student Debtors
print $FD_CF " Student Debtors\t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{STD_Sum} . "\t";
}
print $FD_CF "$CntlCount{STD_Sum}\t";
print $FD_CF "$CONS_Count{student_data_sum}\t";
# General Debtors
print $FD_CF "\n General Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTGD_Sum} . "\t";
}
print $FD_CF "$CntlCount{EXTGD_Sum}\t";
print $FD_CF "$CONS_Count{general_data_sum}\t";
# Third party Contract Debtors
print $FD_CF "\n Third Party Contract Debtors \t" ;
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTTPC_Sum} . "\t";
}
print $FD_CF "$CntlCount{EXTTPC_Sum}\t" ;
print $FD_CF "$CONS_Count{thirdparty_data_sum}\t";
# Grand Total - Line 16
print $FD_CF "\nTotal \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF ($Counts->{STD_Sum} +
$Counts->{EXTGD_Sum} +
$Counts->{EXTTPC_Sum}) . "\t";
}
print $FD_CF " " . ($CntlCount{STD_Sum} +
$CntlCount{EXTGD_Sum} +
$CntlCount{EXTTPC_Sum}) . "\t";
print $FD_CF "$CONS_Count{data_total}\t";
######################
# Error TOTALS CR1187
######################
print $FD_CF "\nSum of error amounts in the following
categories\n";
# Student Debtors
print $FD_CF " Student Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{STD_eSum} . "\t";
}
print $FD_CF "$CntlCount{STD_eSum}\t";
print $FD_CF "$CONS_Count{student_error_sum}\t";
# General Debtors
print $FD_CF "\n General Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTGD_eSum} . "\t";
}
print $FD_CF "$CntlCount{EXTGD_eSum}\t";
print $FD_CF "$CONS_Count{general_error_sum}\t";
# Third party Contract Debtors
print $FD_CF "\n Third Party Contract Debtors \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTTPC_eSum} . "\t";
}
print $FD_CF "$CntlCount{EXTTPC_eSum}\t";
print $FD_CF "$CONS_Count{thirdparty_error_sum}\t";
# Grand Total - Line 21
print $FD_CF "\nTotal \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF ($Counts->{STD_eSum} +
$Counts->{EXTGD_eSum} +
$Counts->{EXTTPC_eSum}) . "\t";
}
print $FD_CF " " . ($CntlCount{STD_eSum} +
$CntlCount{EXTGD_eSum} +
$CntlCount{EXTTPC_eSum}) . "\t";
print $FD_CF "$CONS_Count{error_total}\t";
####################
# DISTINCT STUDENTS - Line 22
print $FD_CF "\nCount of distinct Students \t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{STD_Cnt} . "\t";
}
print $FD_CF "$CntlCount{STD_Cnt}\t";
print $FD_CF "$CONS_Count{distinct_students}\t";
###########################################
# DISTINCT EXTERNAL ORGS - GENERAL DEBTORS - Line 23
print $FD_CF "\nCount of distinct External Orgs - General Debtors
\t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTGD_Cnt} . "\t";
}
print $FD_CF "$CntlCount{EXTGD_Cnt}\t";
print $FD_CF "$CONS_Count{distinct_general}\t";
#######################################
# DISTINCT EXTERNAL ORGS - THIRD PARTY - Line 24
print $FD_CF "\nCount of distinct External Orgs - Third Party
Contracts\t";
foreach $Counts ( sort @InstCounts ) {
print $FD_CF $Counts->{EXTTPC_Cnt} . "\t";
}
print $FD_CF "$CntlCount{EXTTPC_Cnt}\t";
print $FD_CF "$CONS_Count{distinct_thirdparty}\t";
close $FD_CF;
}
=pod
<Control file example. Line numbers only indicative.>
1 Total
systest
2 Count of rows processed (Total including Errors) 2669
2669
3 Count of rows written to data files in the following
4 Student Debtors 2382
2382
5 General Debtors 271
271
6 Third Party Contract Debtors 1 1
6 Total 2654
2654
7 Count of rows written to error files in the following
8 Student Debtors 7 7
9 General Debtors 8 8
10 Third Party Contract Debtors 0 0
11 Total 15
15
12 Sum of outstanding amounts in the following categories
13 Student Debtors 121805.16
121805.16
14 General Debtors 418857.42
418857.42
15 Third Party Contract Debtors 147
147
16 Total 540809.58
540809.58
17 Sum of error amounts in the following categories
18 Student Debtors 295.93
295.93
19 General Debtors 14108.62
14108.62
20 Third Party Contract Debtors 0 0
21 Total 14404.55
14404.55
22 Count of distinct Students 924
924
23 Count of distinct External Orgs - General Debtors 156
156
24 Count of distinct External Orgs - Third Party Contr 1 1
=cut
sub GetInstNumericCode {
my ($lrv);
my ($lsth);
my ($college_code);
my ($sql) = "SELECT college_locn_code FROM syd_ctl ";
$lsth = $dbh->prepare ($sql);
$lrv = $lsth->execute ();
$college_code = $lsth->fetchrow_array;
$lsth->finish;
$dbh->commit;
return $college_code;
}
sub LoadStudProgKeyref ()
{
my ($rv);
my ($CreateStmt) = "";
my ($tempsql) = "";
my ($Result) = "";
my ($localsth);
my ($StudProgKeyRefTable) = "zwu611_stud_prog_keyref";
my ($StudProgKeyRefFile) = $WU600::FilesDir .
"STUD_PROG_KEYREF.dat";
# If STUD_PROGL_KEYREF data file does not exist or file is empty
(size 0),
# terminate the process.
if (( ! -f $StudProgKeyRefFile ) || ( ! -s $StudProgKeyRefFile)) {
die "ERR_WU619_0008 - Stud Prog Reference does not exist. Process has
been terminated. $StudProgKeyRefFile." ;
}
my $TableAgeMax = &WU600::FileAge ($StudProgKeyRefFile);
if ($TableAgeMax == 0) {
$TableAgeMax = 1000;
}
# If STUD_PROG_KEYREF table is older than data file or doesn't
exist,
# then re-create.
if (&WU600::DropTable ($dbh, $StudProgKeyRefTable, $TableAgeMax) >
0) {
# Create STUD_PROG_KEYREF Table
$SQLStmt = "CREATE TABLE $StudProgKeyRefTable (
ps_emplid varchar(10),
cap_crse_code varchar(10),
cap_college_code varchar(3),
cap_award_code integer4,
ps_career varchar(4),
ps_stdnt_car_nbr integer4,
ps_acad_prog varchar(5),
ps_campus varchar(5),
ps_acad_plan varchar(10),
ps_degree_nbr varchar(2),
ps_pilot_flag char(1),
ps_last_prog_action varchar(4),
ps_last_effdt date,
ps_matr_admit_term varchar(4),
ps_degr_chkout_stat varchar(2),
ps_completion_term varchar(4),
ps_last_award_actn varchar(4)) ";
$rv = $dbh->do ($SQLStmt) || &ProgramFinish (1, $dbh->errstr);
$dbh->commit;
# Load data into STUD_PROG_KEYREF Table from data file (if exists)
if ( -f $StudProgKeyRefFile) {
$SQLStmt = "COPY TABLE $StudProgKeyRefTable (
ps_emplid = c0tab,
cap_crse_code = c0tab,
cap_college_code = c0tab,
cap_award_code = c0tab,
ps_career = c0tab,
ps_stdnt_car_nbr = c0tab,
ps_acad_prog = c0tab,
ps_campus = c0tab,
ps_acad_plan = c0tab,
ps_degree_nbr = c0tab,
ps_pilot_flag = c0tab,
ps_last_prog_action = c0tab,
ps_last_effdt = c0tab,
ps_matr_admit_term = c0tab,
ps_degr_chkout_stat = c0tab,
ps_completion_term = c0tab,
ps_last_award_actn = c0nl )
FROM '$StudProgKeyRefFile'";
$rv = $dbh->do ($SQLStmt) ||
&ProgramFinish (1, $dbh->errstr, $StudProgKeyRefTable);
$dbh->commit;
}
}
# Now create a global hash of STUD_PROG_KEYREF students
$tempsql = "SELECT ps_emplid
FROM $StudProgKeyRefTable ";
$localsth = $dbh->prepare ($tempsql);
$rv = $localsth->execute ();
my ($ps_emplid) = "";
while (($ps_emplid) = $localsth->fetchrow_array) {
$StudProgKeyRefHash{$ps_emplid} = 1;
}
$localsth->finish;
$dbh->commit;
}
------------------------------
Date: Wed, 08 Oct 2003 06:10:48 GMT
From: mooseshoes <mooseshoes@gmx.net>
Subject: Re: TCP Listener on Windows XP
Message-Id: <ITNgb.12688$Ii1.1444@newssvr25.news.prodigy.com>
<snip>
> When I run this, and connect a client, I get as far as the "Connect
> from..." message, but the $line=<$client> never returns anything.
<<< TCP is rather particular about knowing when messages end. If you're
getting hung here make sure that the sending computer is sending newline or
carriage return symbols that are familiar to XP.
Moose
-----
Look for decreasing temperatures this winter with the likelihood of warmer
weather in the spring.
------------------------------
Date: Tue, 7 Oct 2003 23:07:44 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: trying to understand a hash
Message-Id: <slrnbo73cg.k9o.tadmc@magna.augustmail.com>
John <jguad98@hotmail.com> wrote:
> the author is not within hollering distance, so I thought I'd try this
> list for assistance.
This is not a list (as in "email list"). This is a Usenet newsgroup.
> where "$hashname" was initialized with "my %hashname",
$hashname has no relationship to %hashname.
$hashname{} has a relationship to %hashname.
(but we know what you meant)
> I was under the impression that a hash in scalar context
A hash used in a scalar context is not useful to a Perl programmer,
it is only useful to a perl programmer.
(it returns 2 numbers with a slash between, try it:
print scalar(%hashname);
)
> should
> look like:
>
> $hashname{$key} = value;
^
^
That is not a hash. That is only one element of a hash.
("one thing" is what dollar sign means.)
"a hash" includes _all_ of the keys and values.
("all of the pairs" is what percent sign means)
> or
> %hashname(key => value);
> or
> %hashname("key","value");
> but not
> %hashname{$key}{$other} = value;
None of those are Perl (5).
> I thought maybe it was intended to be some kind of index notation,
Right!
> but
> the actual value of that var is a string and not a digit,
Perl has a data structure that is indexed by strings rather
than digits.
It is called "a hash". :-)
You can tell it is a hash because it used curlies.
If it was an array at the 2nd level, it would have used squares.
$hashname{$key}[$other] = value; # $other better be a number
> and if it
> was supposed to be a reference of some sort to make or indicate the
> key is another array (hash of hashes?),
^^^^^^^^^^^^^^
Exactly.
I thought you said you didn't understand it? :-)
> Can somebody enlighten me on what that {$other} is all about?
It is indexing a 2nd-level of hash.
> How
> does it work?
perldoc perlreftut
Put this in your code after %hashname has been loaded up, and you
can see its structure:
use Data::Dumper;
...
print Dumper \%hashname;
> Why does it work?
Because that's the way Larry wanted it?
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sat, 19 Jul 2003 01:59:56 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re:
Message-Id: <3F18A600.3040306@rochester.rr.com>
Ron wrote:
> Tried this code get a server 500 error.
>
> Anyone know what's wrong with it?
>
> if $DayName eq "Select a Day" or $RouteName eq "Select A Route") {
(---^
> dienice("Please use the back button on your browser to fill out the Day
> & Route fields.");
> }
...
> Ron
...
--
Bob Walton
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 5633
***************************************
