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

Your program will exit early, as you never wait for the threads to end. I've ripped out all the logfile creation, the batch file reading and usage message, and the following program works just like I expect it to, "processing" 10 stores in parallel:

#!/opt/perl-5.8.8/bin/perl -w
#
#


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

require Data::Dumper;



######## Do not modify if you do not know what you are doing!!! can de
+grade performance!! ########
my $max_thread_count = 10;
######################################################################
+############################

my $version = "0.1_01";


my @stores = sort map { sprintf 'store%03d', $_ } 0..$max_thread_count
+*2;

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

sub writeLog {
   print "$_[0]\n";
}

my $jobs = Thread::Queue->new(@stores);

# read work file
sub processWF {
   my @lines = (
      'perl -wle "print q(storeplaceholder stage 1);sleep(rand(10));pr
+int q(storeplaceholder stage 1 done)"',
      'perl -wle "print q(storeplaceholder stage 2);sleep(rand(10));pr
+int q(storeplaceholder stage 2 done)"',
   );
   while (defined (my $item = $jobs->dequeue)) {
      writeLog("Launching $item");
      foreach my $line (@lines) {
            $line =~ s/storeplaceholder/$item/g;
            #print "running: $line\n";
            system($line) == 0
                or warn "Couldn't launch [$line]: $!/$?";
      }
   }
}


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

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

$_->join() for @workers;

[download]

Consider reducing your programs to the mininmum needed code to reproduce the program while still retaining a full, ready-to-run program. This makes it much easier for us to reproduce the problem and help you. Also, in that process, I usually find the error myself, without posting here.

Replies are listed 'Best First'.
Re^12: Help needed with regard to arrays
by theknightsofni (Novice) on Nov 21, 2008 at 18:22 UTC
    I appreciate your expert help
[reply]
Re^12: Help needed with regard to arrays
by theknightsofni (Novice) on Nov 28, 2008 at 21:24 UTC
    Hi There seems to be a bug with this code....I am trying to figure out whats going on but could use your help.... The rest of the code is the same as you posted but I added a print statement to show whats going on.... 
    
sub processWF {
   my @lines = (
      'perl -wle "print q(storeplaceholder stage 1);sleep(rand(10));pr
+int q(storeplaceholder stage 1 done)"
',
      'perl -wle "print q(storeplaceholder stage 2);sleep(rand(10));pr
+int q(storeplaceholder stage 2 done)"
',
   );

   while (defined (my $item = $jobs->dequeue)) {
      writeLog("Launching $item");
      foreach my $line (@lines) {
            print "replacing $line with $item\n";
            $line =~ s/storeplaceholder/$item/g;
            #print "running: $line\n";
            system($line) == 0
                or warn "Couldn't launch $line: $!";
      }
   }
}

    [download]
[reply]
[d/l]

      This bug is present in Re^8: Help needed with regard to arrays as well, so it just matches what you originally did. But until you tell me what the bug is, how it manifests itself, I won't tell you. Debugging is something that you'll have to learn if you ever want to become a successful programmer. Just saying "There seems to be a bug" is not helpful. As a hint, look at the @lines array during execution.

      Update: I notice you reposted this same question, with just as little explanation at Problem with threading code. I would have appreciated a notice from you, because I wouldn't have spent time on your problem then.

[reply]
[d/l]
        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
[reply]
[d/l]

In Section Seekers of Perl Wisdom