And here's a little test program you can use to ensure the locking itself is working properly. It's a heavily watered-down variant of the unit test program, but it seems to work.
You can run it in two windows simultaneously and see how the locking interacts.
You can also run the second copy with a "2" as its parameter, and it tests the first two files in reverse order. Not sure I remember why that seemed important at the time LOL. Examples:
$ filelock-sample.pl $ filelock-sample.pl 2
#!/usr/bin/perl # -------------------------------------------------------------------- +---------- # filelock-sample - Show basic filelock.pm usage # -------------------------------------------------------------------- +---------- use strict; # -------------------------------------------------------------------- +---------- # Modules we use # -------------------------------------------------------------------- +---------- use filelock; # -------------------------------------------------------------------- +---------- # Constants (operationally, if not technically) # -------------------------------------------------------------------- +---------- # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +-=-=-=-=-= my $RET_SUCCESS = 0; # Return value for success my $RET_FAILURE = 1; # Return value for general f +ailure my $RET_FATAL = (-1); # Return value for fata +l failure my $TRUE = 1; my $FALSE = 0; my $PAUTIM = 10; # Pause time for testing my $LCKFN1 = 'filelock-test1.dat'; my $LCKFN2 = 'filelock-test2.dat'; my $LCKFN3 = 'filelock-test3.dat'; my $TLGFNM = 'filelock.testlog'; # Unit test logfile name my $TL2FNM = 'filelock2.testlog'; # Unit test logfile name f +or 2nd copy # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +-=-=-=-=-= # -------------------------------------------------------------------- +---------- # Globals # -------------------------------------------------------------------- +---------- my $Fatflg; # Fatal operation flag (end +program ASAP) my $Wrkflg; # Did we ever do any work? my $Tstflg = $FALSE; # Are we in unit test mode? my $Fstflg = $FALSE; # Do we do the tests the fa +st way? my $Tstfn1 = $LCKFN1; my $Tstfn2 = $LCKFN2; my $Tstfn3 = $LCKFN3; my $Tlgfnm = $TLGFNM; # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +-=-=-=-=-= # -------------------------------------------------------------------- +---------- # Go Forth and Conquer. No, wait -- that should be "Go Perl and Conqu +er" # -------------------------------------------------------------------- +---------- # ---------------------------------------------------------------- +---------- # Sorry this is so crude; I ripped it out of the unit test for thi +s module. # ---------------------------------------------------------------- +---------- eval { foreach my $curpar (@ARGV) { if ($curpar =~ /^\-/) { # Command line switch if ($curpar =~ /^\-fast/i) { # FAST mode $Fstflg = $TRUE; } else { # Invalid option &usage(); print "Invalid option '$curpar'\n"; } } else { # Regular parameter $Wrkflg = 1; # Yes, we've actually asked for real work +to be done my $retval = &filelocktest($curpar); if ($Fatflg) { return $retval; } } } # Check if there was ever a valid parameter if (!$Wrkflg) { # Nope. Handle the "no valid parameter" condition. # Parameter is not required my $retval = &filelocktest(); if ($Fatflg) { return $retval; } } } ; # End eval{} error trap set REQUIRES a semicolon if ($@) { my $dsperr = $@; print "$dsperr"; } exit; # ==================================================================== +========== # Subroutines # ==================================================================== +========== # -------------------------------------------------------------------- +---------- # filelocktest($curpar) - Unit test for the filelock module # -------------------------------------------------------------------- +---------- sub filelocktest { my ($curpar, @arglst) = @_; if ($curpar eq "2") { # User has indicated this is the second locking test # I cannot remember the scalar swap command name. Do it the ha +rd way. my $tmpfn1 = $Tstfn1; $Tstfn1 = $Tstfn2; $Tstfn2 = $tmpfn1; # Change testing logfile name $Tlgfnm = $TL2FNM; } &test($curpar); } # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +-=-=-=-=-= # -------------------------------------------------------------------- +---------- # test($curpar) - Perform unit testing. # # $curpar: The parameter passed in from filelocktest() - if "2" + I'm 2nd copy. # Returns: Nothing # -------------------------------------------------------------------- +---------- sub test { my ($curpar, @arglst) = @_; # ---------------------------------------------------------------- +---------- { print "TEST: lock() works\n"; my $EXPTST = $TRUE; my $dspret = ''; print "Process $$ locking $Tstfn1\n"; my $lckret = &filelock::lock($Tstfn1); print "Process $$ finished locking $Tstfn1\n"; $dspret .= "lock #1 '$lckret' "; if ($lckret ne $filelock::RET_SUCCESS) { # Failed in a detectable way. print "FAIL!\n"; } else { # Seems to have worked. Sleep awhile, lock #2. if (!$Fstflg) { print "Process $$ sleeping $PAUTIM seconds\n"; sleep $PAUTIM; } print "Process $$ unlocking $Tstfn1\n"; my $secret = &filelock::unlock($Tstfn1); print "Process $$ finished unlocking $Tstfn1\n"; print "Process $$ locking $Tstfn2\n"; my $secret = &filelock::lock($Tstfn2); print "Process $$ finished locking $Tstfn2\n"; $dspret .= "lock #2 '$secret' "; if ($secret ne $filelock::RET_SUCCESS) { # Failed in a detectable way. print "FAIL!\n"; } else { # Seems to have worked. 1st Sleeps awhile. Both lock + #3. if ($curpar ne "2") { if (!$Fstflg) { print "Process $$ sleeping $PAUTIM seconds\n"; sleep $PAUTIM; } } print "Process $$ locking $Tstfn3\n"; my $secret = &filelock::lock($Tstfn3); print "Process $$ finished locking $Tstfn3\n"; $dspret .= "lock #3 '$secret' "; if ($secret ne $filelock::RET_SUCCESS) { # Failed in a detectable way. print "FAIL!\n"; } else { # Seems to have worked. Sleep awhile, unlock. if (!$Fstflg) { print "Process $$ sleeping $PAUTIM seconds\n"; sleep $PAUTIM; } print "Process $$ unlocking $Tstfn2\n"; my $secret = &filelock::unlock($Tstfn2); print "Process $$ finished unlocking $Tstfn2\n"; if (!$Fstflg) { print "Process $$ sleeping $PAUTIM seconds\n"; sleep $PAUTIM; } print "Process $$ unlocking $Tstfn3\n"; my $secret = &filelock::unlock($Tstfn3); print "Process $$ finished unlocking $Tstfn3\n"; } } } $dspret =~ s/^\s+//; $dspret =~ s/\s+$//; print "RESULTS: $dspret\n"; } # ---------------------------------------------------------------- +---------- { print "TEST: duplicate locks stack properly\n"; my $EXPTST = $TRUE; my $EXPCNT = 2; my $EXPCN2 = 1; my $EXPCN3 = 0; my $dspret = ''; #print "DEBUG: First lock...\n"; my $lckret = &filelock::lock($Tstfn1); $dspret .= $lckret; if ($lckret ne $filelock::RET_SUCCESS) { # Failed in a detectable way. print "FAIL!\n"; } else { # Seems to have worked. Lock it again. #print "DEBUG: First lock succeeded...Second lock...\n"; my $secret = &filelock::lock($Tstfn1); $dspret .= "/$secret"; if ($secret ne $filelock::RET_SUCCESS) { # Failed in a detectable way. print "FAIL!\n"; } else { # Both worked. Check lock depth. #print "DEBUG: Second lock succeeded...Checking lock +depth...\n"; my $lckdep = &filelock::getLockCount($Tstfn1); $dspret .= "/$lckdep"; if ($lckdep ne $EXPCNT) { # Lock depth is not what was expected. print "FAIL!\n"; } else { # Right depth. Release locks. #print "DEBUG: Unlock second lock...\n"; my $unlret = &filelock::unlock($Tstfn1); $dspret .= "/$unlret"; my $unldep = &filelock::getLockCount($Tstfn1); if ($unldep ne $EXPCN2) { # Lock depth did not downwardly adjust properl +y. print "FAIL!\n"; } else { # One more unlock to go. #print "DEBUG: Unlock successful...unlock fir +st lock...\n"; my $un2ret = &filelock::unlock($Tstfn1); $dspret .= "/$un2ret"; my $un2dep = &filelock::getLockCount($Tstfn1); if ($un2dep ne $EXPCN3) { # Lock depth did not downwardly adjust pro +perly. print "FAIL!\n"; } else { # Goodness, we're done! #print "DEBUG: Unlock successful...Done w +ith this test.\n"; } } } } } print "RESULTS: $dspret\n"; } # ---------------------------------------------------------------- +---------- }
In reply to Re^2: Threads and output files (locking)
by marinersk
in thread Threads and output files (locking)
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |