in reply to Re^13: Help needed with regard to arrays
in thread Help needed with regard to arrays

You are correct....I will try and give a more detailed explanation below... I have posted the code I am using... and the output....hopefully that will give enough details on this issue. The code parses a file called test.wf ...In the output, when it runs beyond the 10 threads (max_thread_count), the stores repeat themselves...ie for example, in the output below for store 21 , it is running echo 001 (store 001). I hope this is enough detail. I will examine the @lines array as you hinted as well. Thanks, 
#!/opt/perl-5.8.8/bin/perl -w
#

#
#


use strict;
use Getopt::Long;
use threads;
use threads::shared;
use Thread::Queue;

require Data::Dumper;



my $max_thread_count = 10; 

my $version = "0.1";

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time
+);

sub timestamp { 
   my $time;
   $time = sprintf("%04d-%02d-%02d  %02d:%02d:%02d",1900 + $year, $mon
++1, $mday, $hour, $min, $sec);
   return($time);
}

my $date = $mday . $mon+1 . 1900+$year;

my $promoName;
my $storeList;
my $workFile;
my $logFile;
my $ocr;
my $userid;

my $store;
my @stores;
#my @sstores = sort map { sprintf 'store%03d', $_ } 0..$max_thread_cou
+nt*2;
my @sstores;
my $parmStores;

my @failedstores = ();
share(@failedstores);

my $thread; 
my $thread_list;
my $tid;

GetOptions(
        "promoname=s"    =>        \$promoName,        # promo name fo
+r logging purposes
        "sl=s"        =>        \$storeList,        # Store List
                "wf=s"        =>        \$workFile,        # Work file
                "ocr=s"        =>        \$ocr,            # ocr
        "userid=s"    =>        \$userid,        # userid
        "store=s"    =>        \$parmStores,        # individual store
+s if required
);


if (!$promoName || !$workFile || !$userid) {
   printUsage();
   exit 1;
}

if (! $storeList && ! $parmStores ){
   print "Please indicate what you want to use: --sl for storelist fil
+es or --store for individual stores\n";
   exit 1;
}


if ($parmStores){
   @stores =  split(/,/, $parmStores);
}


if ($storeList){
   if (! -f $storeList){
      print "Error: $storeList not found\n";
      exit 1;
   }
}

if (! -f $workFile){
   print "Error: $workFile not found\n";
   exit 1;
}

my $logFolder = "log/$promoName";
if (! -d $logFolder){
   my $cmd = system("mkdir $logFolder");
}

$logFile = "$logFolder/$promoName.$date.$userid.log";


sub writeLog {
   open(LOGFILE, ">>$logFile");
   print LOGFILE &timestamp() . " $_[0]\n";
}

sub failedStore {
   my $val = shift;
   push(@failedstores,$val);
}

# usage instructions
sub printUsage {
   print "sendpromo v$version\n";
   print "USAGE: $0
        --promoname=promo name (for logging) - REQUIRED
    --sl=storelist files (can be seperated by commas) - REQUIRED
        --store=<stores comma seperated> (example: 001, 002 etc)
        --wf=work file - REQUIRED
        --ocr=xxxx (example 1234)
        --userid=userid - REQUIRED
   \n";
}


# read store list(s)

my $buffer;
my $num_lines;

sub readSL {
   my @list = split(/,/, $storeList);
   foreach my $storefile (@list) {
      print "opening $storefile\n";
      open(STORELIST, "<$storefile");
      @stores = <STORELIST>;
      chomp @stores;
      @stores = sort @stores;
   }
}

sub convertStores {
   foreach my $store(@stores){
      $store = "s" . $store;
      push(@sstores, $store);
   }
}


print "------------------------------------------\n";
print "sendpromo v$version\n";
if ($ocr){
   print "OCR #: $ocr\n";
}
print "------------------------------------------\n";


writeLog("Starting for $promoName initiated by $userid");

unless($parmStores){
   readSL();
}



#convertStores();
print "stores: @stores\n";
#print "sstores: @sstores\n";

my $jobs = Thread::Queue->new(@stores);
print "jobs: $jobs\n";

# read work file
sub processWF {
   my $val = shift;
   open(WORKFILE, "<$workFile");
   my @lines = <WORKFILE>;
   chomp @lines;
   while (defined (my $item = $jobs->dequeue)) {
      print "prog: running for $item\n";
      writeLog("Creating thread for: $item");
      foreach my $line (@lines) {
         $line =~ s/storeplaceholder/$item/g;
         if ($ocr) {
            $line =~ s/dateplaceholder/$date/g;
            $line =~ s/ocrplaceholder/$ocr/g;
         }   
         print "Running: $line\n";
         print "system: running $line for $item\n";
         if (system($line) != 0){
            writeLog("ERROR: Could not process $item : $line: $!");
            failedStore($item);
         }
      }
   }
   close(WORKFILE);
}


$jobs->enqueue(undef) for 1..$max_thread_count;

my @workers = map { threads->create( \&processWF ) } 1..$max_thread_co
+unt;

$_->join() for @workers;


if (@failedstores){
   my %fshash = map { $_ => 1 } @failedstores;
   @failedstores = sort keys %fshash; 
   open(FS, ">stores.failed");
   foreach my $fs (@failedstores){
      $fs = substr $fs, 1; 
      print FS $fs .  "\n";
   }
   close FS;
   print "\n\nstores.failed created ... please re-run sendpromo agains
+t this when the stores are available\n";
   writeLog("stores.failed created. Please re-run sendpromo against th
+is when the stores are available\n");
}


close(LOGFILE);

print "---------------------------------------------------------------
+-----------------\n\n";
print "sendpromo complete.....Please check $logFile for additional inf
+ormation....\n\n";
print "---------------------------------------------------------------
+-----------------\n";


0;

[download]
The file that the code above is parsing: test.wf
echo storeplaceholder

Output:
------------------------------------------
sendpromo v0.1
------------------------------------------
opening storelist.test<br? stores: 001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023
jobs: Thread::Queue=ARRAY(0x28f624)
prog: running for 001
Running: echo 001
system: running echo 001 for 001
001 prog: running for 002 Running: echo 001 system: running echo 001 for 002 001 prog: running for 003 Running: echo 001 system: running echo 001 for 003 001 prog: running for 004 Running: echo 001 system: running echo 001 for 004 001 prog: running for 005 Running: echo 001 system: running echo 001 for 005 001 prog: running for 006 prog: running for 007 Running: echo 006 Running: echo 001 system: running echo 006 for 006 system: running echo 001 for 007 006 prog: running for 008 Running: echo 006 system: running echo 006 for 008 001 prog: running for 009 Running: echo 001 system: running echo 001 for 009 006 prog: running for 010 Running: echo 006 system: running echo 006 for 010 001 prog: running for 011 Running: echo 001 system: running echo 001 for 011 006 prog: running for 012 Running: echo 006 system: running echo 006 for 012 001 prog: running for 013 Running: echo 001 system: running echo 001 for 013 006 prog: running for 014 Running: echo 006 system: running echo 006 for 014 001 prog: running for 015 Running: echo 001 system: running echo 001 for 015 006 prog: running for 016 Running: echo 006 system: running echo 006 for 016 001 prog: running for 017 Running: echo 001 system: running echo 001 for 017 006 prog: running for 018 Running: echo 006 system: running echo 006 for 018 001 prog: running for 019 Running: echo 001 system: running echo 001 for 019 006 prog: running for 020 Running: echo 006 system: running echo 006 for 020 001 prog: running for 021 Running: echo 001 system: running echo 001 for 021 006 prog: running for 022 Running: echo 006 system: running echo 006 for 022 001 prog: running for 023 Running: echo 001 system: running echo 001 for 023 006 001

Replies are listed 'Best First'.
Re^15: Help needed with regard to arrays
by Corion (Patriarch) on Dec 01, 2008 at 18:30 UTC

    Why do you even reply before having investigated @lines? There is no need to keep me constantly posted about whatever changes you make. Do not reply until you encounter a new problem.

[reply]
[d/l]
      OK , I checked out @lines. It appears that the code is "working as written". The "storeplaceholder" gets overwritten by the value of $item but then that $line is assigned to the next thread. The regular expression obviously fails since there is no "storeplaceholder" to replace. Is there a better way to do this? I have tried share(@lines) and lock() with no luck....but I dont think that is the issue here...
[reply]

        Yes, you found the problem. A simple approach could be to use a copy of @lines to modify and then execute. That way you would still have the original @lines around for the next round.

        Why do you think that share() or lock() come into play? Is the problem related to threads? Did you check that? You can easily switch your program into single-threaded mode. Does the error persist?

        Note that these are all rhetorical questions for me - they are intended to guide you in the process of debugging and eliminating all other possible causes.

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom