Greetings,

I'm a former hardware guy (embedded C & C++ experience mainly) trying to get up to speed with Java and Perl for a set of graduate courses.

I've written up a Perl script that simulates a scheduling algorithm, the script consists of two primary loops the first to parse process/event info from a file, the second to schedule each event. The first loop executes fine, but I'm having issues getting the script to run with my second loop - since I'm doing this in Perl (with no main block) I'm concerned it may have something to do with the scope of my vars (my three primary data structures are a 2d array used as an array of stacks, and two hashes used to reference event dependencies.

I am using Eclipse/EPIC/ActiveState Perl 5.8.6 to debug my script. I'm a noob at this, although I've had some experience using regular expressions/Perl in a Unix environment, admittedly at the moment I'm completely stuck...

Parse loop (appears to work fine):


foreach $line (<FILE>)
{
chomp $line;


if ($line =~ m/(\d)-(\d)->(\d)-(\d)/)
{
#create local sender and receiver vars
my $sp = "$1-$2";
my $rp = "$3-$4";


#update sender and receiver hashes
$sender{$sp} = $rp;
$receiver{$rp} = $sp;


print "enter $sender{$sp}->$receiver{$rp} in dependency hashes\n";
}
elsif($line =~ m/(\d)-(\d)/)
{
#create local process var
my $p = "$1-$2";


#queue process on @p_s multi-dimensional array
unshift (@{$p_s[$1]},$p);
print "unshift $p_s[$1][0] onto process array\n";
$numevents++;
}
else
{
print "\nunmatched line: $line \n";
chomp($line); #remove empty newlines in input file
}
}


Scheduling loop (script produces no output with this included)


while($timestamp <= $numevents)
{
print "\ntimestamp: $timestamp, numevents: $numevents\n";
foreach $pid (@p_s)
{
my $p_e = 0, $p_t = 0;


#for every process pop the first event and examine it
if($p_e = pop @{$p_s[$pid]})
{


#if process-event has receiver-dependency then push it back on the stack
if($receiver{$p_e})
{
push (@{$p_s[$pid]},$p_e);
}
else
{
my $s_o = 0;
#else if process-event has sender-obligation then update sender and reciever hashes
if($s_o = $sender{$p_e})
{
delete $sender{$p_e};
delete $receiver{$s_o};
}


#and then enqueue process-event with process-timestamp in schedule hash
if($p_e =~ m/(\d)-(\d)/)
{
$p_t = "$timestamp.$1"
}
else
{
print "\nerror parsing processor-event signature\n";
}


$schedule{$p_e} = $p_t;
unshift (@totalorder, $p_t);
}
}
}
$timestamp++;
}

Since the timestamp of each event is it's occurance relative to every other event, I don't need any abosolute means of stamping each event, and I can say that my $timestamp < $numevents always. I do need to output the total order of events, as well as each event and it's timestamp, hence I create a third and fourth hash and array respectively, %schedule and @totalorder. I have created a subroutine check_data() that outputs all of the data stored in all of my major data structures, the definition for this is located after all of the code I have in what would be my main() block in C/C++.

Sorry for the lengthy description - anyone here have an idea why the first loop would execute but not the second?

Do I need to initialize my vars prior to use, ex:

$pid = 0; #process index
@p_s = (); #2d process array/stack
%sender = (); #sending event hash
%receiver = (); #receiving event hash
$numevents = 0; #total number of events in all processes
$timestamp = 0; #timestamp for event scheduler
%schedule = (); #hash of each event with timestamp
@totalorder = (); #final order of each event

Should be declared before the first loop (I've tried this already w/o success but maybe I'm missing something)?

Will vars declared on the fly in the first loop be visible in the second loop?

I will append the full script at the end of this post for the reference of the more experienced perl-sons who are hopefully perusing this forum...

###################Lamport.pl
###################


#!/usr/bin/perl -w
#begin main routine


#$pid = 0; #process index
#@p_s = (); #process stack
#%sender = (); #sending event hash
#%receiver = (); #receiving event hash
#$numevents = 0; #total number of events in all processes
#$timestamp = 0; #timestamp for event scheduler
#%schedule = (); #= Tie::IxHash->new();
#@totalorder = ();


#read process/event input from file
open FILE, $ARGV[0]
or die "$ARGV[0] can't be opened:\n$!";
#local $/;   # Set input to "slurp" mode.


#initialize process/event stack/hash from input file
print "\nbegin Lamport's algorithm for input file $ARGV[0]\n";


foreach $line (<FILE>)
{
chomp $line;


if ($line =~ m/(\d)-(\d)->(\d)-(\d)/)
{
#create local sender and receiver vars
my $sp = "$1-$2";
my $rp = "$3-$4";


#update sender and receiver hashes
$sender{$sp} = $rp;
$receiver{$rp} = $sp;


print "enter $sender{$sp}->$receiver{$rp} in dependency hashes\n";
}
elsif($line =~ m/(\d)-(\d)/)
{
#create local process var
my $p = "$1-$2";


#queue process on @p_s multi-dimensional array
unshift (@{$p_s[$1]},$p);
print "unshift $p_s[$1][0] onto process array\n";
$numevents++;
}
else
{
print "\nunmatched line: $line \n";
chomp($line); #remove empty newlines in input file
}
}


print "\ncompleted $ARGV[0] parsing\n";
close FILE;


check_data();


#schedule process events according to Lamport's algorithm
while($timestamp <= $numevents)
{
print "\ntimestamp: $timestamp, numevents: $numevents\n";
foreach $pid (@p_s)
{
my $p_e = 0, $p_t = 0;


#for every process pop the first event and examine it
if($p_e = pop @{$p_s[$pid]})
{


#if process-event has receiver-dependency then push it back on the stack
if($receiver{$p_e})
{
push (@{$p_s[$pid]},$p_e);
}
else
{
my $s_o = 0;
#else if process-event has sender-obligation then update sender and reciever hashes
if($s_o = $sender{$p_e})
{
delete $sender{$p_e};
delete $receiver{$s_o};
}


#and then enqueue process-event with process-timestamp in schedule hash
if($p_e =~ m/(\d)-(\d)/)
{
$p_t = "$timestamp.$1"
}
else
{
print "\nerror parsing processor-event signature\n";
}


$schedule{$p_e} = $p_t;
unshift (@totalorder, $p_t);
}
}
}
$timestamp++;
}


check_data();


#create "totalorder" copy of schedule hash


#pop totalorder as stack and print


#sort and print schedule hash


#end MAIN routine


#begin subroutine definitions


sub check_data
{
#print "numprocs = $numprocs\n";
print "\ntimestamp = $timestamp\n";
print "numevents = $numevents\n";


print "\ncontents of process stack:\n";
foreach my $r (@p_s)
{
my $j=0;
foreach my $c (@{$r})
{
print "P$i j: $j Value: $c\n";
$j++;
}
$i++;
print "\n";
}


print "\nsender key/value pairs:\n";
foreach my $k (sort keys %sender)
{
print "$k => $sender{$k}\n";
}


print "\nreceiver key/value pairs:\n";
foreach my $k (sort keys %receiver)
{
print "$k => $receiver{$k}\n";
}


print "\nschedule key/value pairs:\n";
foreach my $k (sort keys %schedule)
{
print "$k => $schedule{$k}\n";
}


print "\ncontents of totalorder queue:\n";
foreach my $r (@totalorder)
{
print "$r, ";
}


print "\n\n";
}

Edited 3 Years Ago by happygeek: fixed formatting

I see a couple problems with this script (besides it grabbing over 1025MB of memory when i ran it under linux, which it didn't do under windows)

First, you should always use this line at the top of your perl program:

use strict;

Fix all the warnings this will produce.
You can define the global hashes and arrays at the top of the file something like this:

my (%sender,%receiver,%schedule,@p_s,@totalorder);

The loop control variable $numevents only gets incremented if the elsif regex matches. Should it increment in the first regex's block? Initialize $timestamp too, even if to zero to avoid warnings from strict and -w. =)

The second problem was with $pid. $pid should be initialized to some value. Since $pid is an array index in the line:

if($p_e = pop @{$p_s[$pid]})

it should only be numeric. It isn't numeric when the second loop gets it. The lines:

my $p = "$1-$2";
 
#queue process on @p_s multi-dimensional array
unshift (@{$p_s[$1]},$p);

put the digit-dash-digit matches from the second regex onto the array @p_s. That causes an error when i tried a dummy file with lines like this:
1-2
5-6
7-8

The third problem is the two regular expressions:

if ($line =~ m/(\d)-(\d)->(\d)-(\d)/)
and
elsif($line =~ m/(\d)-(\d)/)

The first will match lines like this:

blahblah 1-2->3-4 blahblah

The second will match anything with a digit dash digit in it. Dig? hehe
If your process numbers have more than one digit, you'll want something more like this:

/^(\d+)-(\d+)->(\d+)-(\d+)$/

Use the ^ and $ to match beginning and end of lines to avoid matching comment lines etc, if any.

I didn't get into the second loop. If you have an example data line for the two regex cases, I can give it a shot.

Kordaff

Hi
Im so nood in perl and i have a problem need.
When i ever i run this dts_add.pl the run date is not backward compatible.
I ran this program every month and and reference the date from which it was previously ran.
I wanted to run a file dated 2 months ago and i coudnt run it.
Can somebody help me.
Thanks,
Andrew..

This is the code:

use Win32::ADO;
use Win32::OLE;
use Win32::OLE::Variant;

# Time Variables
  $time1 = localtime();  # Time of Start of Program
    ($tsec, $tmin, $thour, $tmday, $tmon, $tyear) = localtime();
    $tmon++;
    $tyear = 1900 + $tyear;
  $time2 = time() - (1 * 24 * 60 * 60); # Date Yesterday for Query
    ($sec, $min, $hour, $mday, $mon, $year) = localtime($time2);
        $mon++; # Increments Month by One
        $year = 1900 + $year; # Adds to Make Year Correct
        if (length($mday) < 2) {
           $mday = "0$mday";
        } 
    $DateRec = "$mon/$mday/$year";
    $SeaDate = "$mday/$mon/$year";
    $RunDate = "";

sub date_change {
    local ($param_1, $param_2) = @_;
    if ($param_2 == '1') {
  # Convert Date for Oracle Query
    $sla1 = index($param_1, "/");
    $sla2 = index($param_1, "/", $sla1+1);

        $currDay = substr($param_1, 0, $sla1);
#       $currDay = "0" . $currDay  if $currDay < 10;
        $currMon = substr($param_1, ($sla1+1), ($sla2-$sla1-1));
        if ($currMon == 1) {$cuMon = "JAN";}
        elsif ($currMon == 2) {$cuMon="FEB";}
        elsif ($currMon == 3) {$cuMon="MAR";}
        elsif ($currMon == 4) {$cuMon="APR";}
        elsif ($currMon == 5) {$cuMon="MAY";}
        elsif ($currMon == 6) {$cuMon="JUN";}
        elsif ($currMon == 7) {$cuMon="JUL";}
        elsif ($currMon == 8) {$cuMon="AUG";}
        elsif ($currMon == 9) {$cuMon="SEP";}
        elsif ($currMon == 10) {$cuMon="OCT";}
        elsif ($currMon == 11) {$cuMon="NOV";}
        elsif ($currMon == 12) {$cuMon="DEC";}
        $currYear = substr($param_1, ($sla2+1), 2);
        $currDate = "$currDay-$cuMon-$currYear"; # Formats the date so it can be queried from the Oracle Database
        }
        else {
             $currDate = "20" . join("", reverse( $param_1 =~ m#(\d{2})/(\d{2})/(\d{2})# ));
          }
        return($currDate);
}

# Open Log File to Log any Errors and Successes
  open (LogFile, ">> n:/Web_Site/insp_dev/smmc/quality/queries/dts_Log_File.txt");
  flock (LogFile, 2);
  print LogFile "\n-------------------- $time1 --------------------\n";

# Set Variables to Count Records
  $CountRows = 0;
  $CountNLC = 0;
  $CountNDup = 0;
  $CountDup = 0;
  $CountWip = 0;
  $CountNeg = 0;
  $CountDupRec = 0;
  $Dup = "";

# Opens smmc_dts.txt file and reads records into an database.
  open (DTS, "c:/InetPub/ftproot/smmc_dts.txt") || die;

# Opens Last Recorded Date
  open(run_date, "< n:/Web_Site/insp_dev/smmc/quality/queries/dts_run_date.txt");
  @lines = <run_date>;
  foreach $line (@lines) {
    $compare = $line;
    }
  close(run_date);

# Setup Connections to Databases
  $conn = Win32::OLE->new("ADODB.Connection");
  $conn->Open("DSN=smmcdev;UID=web_login;PWD=4website");

# Reads through and adds records to the database
while ($results = <DTS>) {
    @record = split(/\|/, $results);
    $Totalres = @record;
    $returnDate = &date_change(@record[4], 1);
    $compareDate = &date_change(@record[4], 2);
    print "returnDate: $returnDate | compareDate: $compareDate | compare: $compare \n";
    if ($compareDate gt $RunDate) {
       $RunDate = $compareDate;
       }
    if ($compare lt $compareDate) {
    for ($x=0; $x<$Totalres; $x++) {
        @record[$x] =~ s/^\s*(.*?)\s*$/$1/;
    }
    $CountRows++;
    if (@record[7] gt '0') {
    $comp = Win32::OLE->new("ADODB.Recordset");
    $sql = "SELECT ID FROM DTS WHERE (('@record[5]' Like Part_No) AND (Vendor_No = @record[1]) AND ('$returnDate' BETWEEN Implementation_Date and Cancel_Date))";
    $comp = $conn->execute($sql);
    if ($comp->EOF) {
        $CountNDup++;
     }
     else {

           $Sql = "INSERT INTO Inspection_Record_Header (Part_No, Lot, PO_No, PO_Line, Lot_Quantity, Quantity_Accepted, RCF, Product_Line, Comm_Code, Vendor_No, Vendor_Name, Date_Received, Hub, Comments, Form_Rev, Quantity_Rejected, Inspect_Time, Inspect_Scrap) VALUES ('@record[5]', 'DTS-@record[2]@record[3]', '@record[2]', '@record[3]', @record[6], @record[6], 'SMMC', '@record[8]', '@record[7]', @record[1], '@record[0]', '$returnDate', 'SMMC', 'DTS Parts Populated by dts_add.pl automatically.  Run date:  $tmon/$tmday/$tyear.', '1', 0, 0, 0)";

       $CountNLC++;

       $conn->execute($Sql);
       print LogFile "@record[0]\n";
       print LogFile "@record[1]\n";
       print LogFile "@record[2]\n";
       print LogFile "@record[3]\n";
       print LogFile "@record[5]\n";
       print LogFile "@record[6]\n";
       print LogFile "@record[7]\n";
       print LogFile "@record[8]\n";
     }
        if ($comp) {
           $comp->Close;
           }
    }
    }
    else {
         $CountNeg++;
         }
}   
    $conn->Close;
    close DTS;

#   unlink "c:/InetPub/ftproot/smmc_dts.txt";

Edited 3 Years Ago by pyTony: fixed formatting

This article has been dead for over six months. Start a new discussion instead.