How do I lock a file in Perl?

前端 未结 14 607
礼貌的吻别
礼貌的吻别 2020-12-01 05:45

What is the best way to create a lock on a file in Perl?

Is it best to flock on the file or to create a lock file to place a lock on and check for a lock on the lock

14条回答
  •  佛祖请我去吃肉
    2020-12-01 06:12

    Developed off of http://metacpan.org/pod/File::FcntlLock

    use Fcntl qw(:DEFAULT :flock :seek :Fcompat);
    use File::FcntlLock;
    sub acquire_lock {
      my $fn = shift;
      my $justPrint = shift || 0;
      confess "Too many args" if defined shift;
      confess "Not enough args" if !defined $justPrint;
    
      my $rv = TRUE;
      my $fh;
      sysopen($fh, $fn, O_RDWR | O_CREAT) or LOGDIE "failed to open: $fn: $!";
      $fh->autoflush(1);
      ALWAYS "acquiring lock: $fn";
      my $fs = new File::FcntlLock;
      $fs->l_type( F_WRLCK );
      $fs->l_whence( SEEK_SET );
      $fs->l_start( 0 );
      $fs->lock( $fh, F_SETLKW ) or LOGDIE  "failed to get write lock: $fn:" . $fs->error;
      my $num = <$fh> || 0;
      return ($fh, $num);
    }
    
    sub release_lock {
      my $fn = shift;
      my $fh = shift;
      my $num = shift;
      my $justPrint = shift || 0;
    
      seek($fh, 0, SEEK_SET) or LOGDIE "seek failed: $fn: $!";
      print $fh "$num\n" or LOGDIE "write failed: $fn: $!";
      truncate($fh, tell($fh)) or LOGDIE "truncate failed: $fn: $!";
      my $fs = new File::FcntlLock;
      $fs->l_type(F_UNLCK);
      ALWAYS "releasing lock: $fn";
      $fs->lock( $fh, F_SETLK ) or LOGDIE "unlock failed: $fn: " . $fs->error;
      close($fh) or LOGDIE "close failed: $fn: $!";
    }
    

提交回复
热议问题