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

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.

Replies are listed 'Best First'.
Re^14: Help needed with regard to arrays
by theknightsofni (Novice) on Dec 01, 2008 at 17:36 UTC
    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;
    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

      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.

        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...