home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / comp / lang / perl / 7096 < prev    next >
Encoding:
Text File  |  1992-11-22  |  2.2 KB  |  83 lines
  1. Newsgroups: comp.lang.perl
  2. Path: sparky!uunet!think.com!sdd.hp.com!ux1.cso.uiuc.edu!news.cso.uiuc.edu!chappell
  3. From: chappell@symcom.math.uiuc.edu (Glenn Chappell)
  4. Subject: flock bug? man page error?
  5. Message-ID: <By51CH.5G9@news.cso.uiuc.edu>
  6. Sender: usenet@news.cso.uiuc.edu (Net Noise owner)
  7. Organization: Math Dept., University of Illinois at Urbana/Champaign
  8. Date: Sun, 22 Nov 1992 22:05:03 GMT
  9. Lines: 72
  10.  
  11. I am writing a utility in Perl which will need to use file locking.
  12.  
  13. The section of the Perl man page describing the "flock" command gives a
  14. mailbox appender for BSD systems. As a test, I wrote the following
  15. program, slightly modified from the one given in the man page. It
  16. appends the line "test" to the file whose name is given to it as a
  17. command line parameter. It uses file locking to make sure that it still
  18. works if you run several copies of it at once.
  19.  
  20. Unfortunately, this program doesn't work properly. When I run 32 copies
  21. of it more-or-less simultaneously, somewhere around 22 "test" lines get
  22. appended to the given file. However, if I change the "print" to a
  23. "syswrite", it works, and I get 32 appended lines.
  24.  
  25. Specifically, I changed 
  26.  
  27. print FILE $msg;
  28.  
  29. to
  30.  
  31. syswrite(FILE, $msg, length($msg));
  32.  
  33. and it worked. Do any of you wonderful people have any idea what's going
  34. on here? Does this mean the man page needs to be changed?
  35.  
  36. The program:
  37.  
  38. ----------------------------------------
  39. #!/usr/local/bin/perl
  40.  
  41. $LOCK_SH = 1;
  42. $LOCK_EX = 2;
  43. $LOCK_NB = 4;
  44. $LOCK_UN = 8;
  45.  
  46. sub lock {
  47.     flock(FILE,$LOCK_EX);
  48.     # and, in case someone appended
  49.     # while we were waiting...
  50.     seek(FILE, 0, 2);
  51. }
  52.  
  53. sub unlock {
  54.     flock(FILE,$LOCK_UN);
  55. }
  56.  
  57. open(FILE, ">>$ARGV[0]")
  58.      || die "Can't open file: $!";
  59.  
  60. do lock();
  61. $msg = "test\n";
  62. print FILE $msg;
  63. do unlock();
  64. ----------------------------------------
  65.  
  66.                 Glenn Chappell  <><
  67.  
  68. P.S. Versions & such:
  69.  
  70. The box in front of me says "Sun 3/50" on it. I'm running SunOS 4.1.1_U1.
  71.  
  72. perl -v saith:
  73.  
  74. ]This is perl, version 4.0
  75. ]
  76. ]$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45 $
  77. ]Patch level: 19
  78. ]
  79. ]Copyright (c) 1989, 1990, 1991, Larry Wall
  80. ]
  81. ]Perl may be copied only under the terms of either the Artistic License or the
  82. ]GNU General Public License, which may be found in the Perl 4.0 source kit.
  83.