No, it's not very big--might be kinda ugly to you expert Perl programmers,
but ... I'll swallow my pride and post it. I'm using ActivePerl v5.8.3 on
NT against an Oracle database running on AIX. The DBI/DBD version I'm using
is one I downloaded from Jeff [forgot his last name]'s directory as posted
to this list (DBI version 1.14 written by Tim Bunce for MsWin32).
Here's my script:
#process_chunkmail.pl
use DBI;
use Date::Manip;
#---------------------------------------------------------------------------
-----------------------------
# Assign the proper values to variables in this group before running script:
#---------------------------------------------------------------------------
-----------------------------
$DB_CONN = "DBI:Oracle:KOTA";
$DB_USER = "JUNK";
$DB_PASS = "IDS2TESTW_";
$add_test_to_fname = 1; #(Set this var to 0 to STOP adding
'TEST_' to output file names.)
$want_debug_msg = 0; #(Set this var to 1 to see debug
msgs in output file when testing)
#---------------------------------------------------------------------------
-----------------------------
# Create output file name in required format (including timestamp):
#---------------------------------------------------------------------------
-----------------------------
$rootname = "BenandJerry2004ChunkMailNewsletter";
#Create a timestamp to use as part of output file name:
($sec,$min,$hour,$mday,$mon,$year) = localtime();
$year += 1900;
$mon += 1;
if ($mon < 10) { $mon = "0$mon"; };
if ($mday < 10) { $mday = "0$mday";};
if ($hour < 10) { $hour = "0$hour";};
if ($min < 10) { $min = "0$min" ;};
if ($sec < 10) { $sec = "0$sec"; };
$timestamp = "$year$mon$mday$hour$min$sec";
if ($add_test_to_fname) {
$output_file_name = "TEST_$rootname.$timestamp.txt";
} else {
$output_file_name = "$rootname.$timestamp.txt";
};
#---------------------------------------------------------------------------
-----------------------------
# Connect to the database and read all the records in. (Selecting ALL
allows this script to deal
# "generically" with the BIT-type fields with the 'Unless', without needing
to know how data is stored).
# While reading records in, examine contact dates, and save the earliest one
to be used in the output
# file's Header record.
#---------------------------------------------------------------------------
-----------------------------
$dbh = DBI->connect($DB_CONN, $DB_USER, $DB_PASS) || die "Can't connect:
$dbi::errstr";
open(STDOUT, ">>$output_file_name") or die "\nCould not open STDOUT: $!";
$sth = $dbh->prepare("SELECT * FROM Chunkmail");
$sth->execute();
# Initialize "earliest" to a date faaaaaar in the future:
$earliest_contact = UnixDate("30000101","%Y%m%d");
$idx = 0;
while($row = $sth->fetchrow_hashref()) {
@contribute_flag[$idx] = $row->{CONTRIBUTE_FLAG};
#---------------------------------------------------------------------------
-------
# Read & store rest of the record only IF its Contribute Flag is not set:
#---------------------------------------------------------------------------
-------
unless ($contribute_flag[$idx]) {
@contact_date[$idx] = UnixDate($row->{CONTACT_DATE}, "%Y%m%d");
$cmp_rslt = Date_Cmp($contact_date[$idx], $earliest_contact);
if ($cmp_rslt < 0) {
#Date1 (i.e., date on this record) is earlier, so save it as
"earliest contact":
if ($want_debug_msg) {print "Cntct_date $contact_date[$idx] is
earlier than prev earliest $earliest_contact; keeping it.\n";};
$earliest_contact = $contact_date[$idx];
};
@chunkmail_id[$idx] = $row->{CHUNKMAIL_ID};
@firstname[$idx] = $row->{FIRSTNAME};
@lastname[$idx] = $row->{LASTNAME};
@address1[$idx] = $row->{ADDRESS1};
@address2[$idx] = $row->{ADDRESS2};
@city[$idx] = $row->{CITY};
@state[$idx] = $row->{STATE};
@zip[$idx] = $row->{ZIP};
@email[$idx] = $row->{EMAIL};
@dob[$idx] = $row->{DOB};
@opt_in[$idx] = $row->{OPT_IN};
@flavor1_response_id[$idx]= $row->{FLAVOR1_RESPONSE_ID};
@flavor2_response_id[$idx]= $row->{FLAVOR2_RESPONSE_ID};
@cust_years_id[$idx] = $row->{CUST_YEARS_ID};
@status[$idx] = $row->{STATUS};
@email_type[$idx] = $row->{EMAIL_TYPE};
@franchise_id[$idx] = $row->{FRANCHISE_ID};
$idx = $idx + 1;
};
};
#---------------------------------------------------------------------------
-----------------------------
# Write header record to output file:
#---------------------------------------------------------------------------
-----------------------------
print "CR|4|9999000000103||BJCHUNK|BJCHUNK|51|Ben and Jerry\'s 2004
-ChunkMail subscription";
print "|2106|Ben and Jerry\'s 2004 01 -ChunkMail subscription
requests|4683|11";
print "|Ben and Jerry\'s e-newsletter
subscription||$earliest_contact||114|476|||||||\n";
#---------------------------------------------------------------------------
-----------------------------
# Run through all saved records, creating rest of output & setting the
contribute_flag for each in the db:
#---------------------------------------------------------------------------
-----------------------------
if ($want_debug_msg) {print "\nBefore running through arrays, record count
was: $idx.\n\n";};
foreach (0..$idx-1) {
if ($want_debug_msg) {print "Processing record for $firstname[$_];
contribflag=$contribute_flag[$_]\n";};
print
"NA|4|$chunkmail_id[$_]||||||$firstname[$_]||$lastname[$_]||$address1[$_]|$a
ddress2[$_]";
print
"|1|$city[$_]|$state[$_]|$zip[$_]|||||||||$email[$_]||$dob[$_]|||$contact_da
te[$_]|\n";
if ($opt_in[$_]) {
print
"PTC|4|$chunkmail_id[$_]|$franchise_id[$_]|Y|||||$contact_date[$_]|\n";
} else {
print
"PTC|4|$chunkmail_id[$_]|$franchise_id[$_]|N|||||$contact_date[$_]|\n";
};
print
"QR|4|$chunkmail_id[$_]||667|$flavor1_response_id[$_]||$contact_date[$_]|\n"
;
print
"QR|4|$chunkmail_id[$_]||668|$flavor2_response_id[$_]||$contact_date[$_]|\n"
;
if ($cust_years_id[$_]) {
print
"QR|4|$chunkmail_id[$_]||669|$cust_years_id[$_]||$contact_date[$_]|\n";
};
print
"SUB|4|$chunkmail_id[$_]|22|$status[$_]|$contact_date[$_]||$email_type[$_]|9
||$contact_date[$_]\n";
$rslt = $dbh->do("UPDATE Chunkmail SET CONTRIBUTE_FLAG=1 WHERE
CHUNKMAIL_ID=" . $chunkmail_id[$_]);
print $dbh->errstr(),"\n" unless ($rslt);
$rslt = $dbh->do("COMMIT");
print $dbh->errstr(),"\n" unless ($rslt);
}; #end for
#----------
# Clean up:
#----------
$sth->finish();
close(STDOUT);
$dbh->disconnect();
-----Original Message-----
From: Hardy Merrill [mailto:[EMAIL PROTECTED]
Sent: Wednesday, March 24, 2004 2:49 PM
To: [EMAIL PROTECTED]; [EMAIL PROTECTED]
Subject: Re: Why won't my script terminate?
I don't see anything wrong with your code - is the "bunches of stuff"
section too big to include? Also include the standard versions of OS,
Perl, DBI, which database you're using and which DBD (and version of
DBD).
>>> Laurie Vien <[EMAIL PROTECTED]> 03/24/04 02:44PM >>>
I am running a very simple Perl script using DBI (skeleton of it
follows).
It does everything I expect it to, but the problem is it doesn't
finish
until I Ctrl-C, at which time I get the message "Terminating on signal
SIGINT(2)". What have I left out or done in the wrong order that
causes it
not to terminate?:
#MyPerlScript.pl
use DBI;
use Date::Manip;
$dbh = DBI->connect($DB_CONN, $DB_USER, $DB_PASS) || die "Can't
connect:
$dbi::errstr";
open(STDOUT, ">>myfile.txt") or die "\nCould not open STDOUT: $!";
$sth = $dbh->prepare("SELECT * FROM MyTable");
$sth->execute();
# < Do bunches of stuff here ....>
#
#
$sth->finish();
$dbh->disconnect();
close(STDOUT);
Laurie