diff options
| -rw-r--r-- | fml/lib/FML/Lock.pm | 171 | ||||
| -rw-r--r-- | fml/lib/FML/Process/Kernel.pm | 6 | ||||
| -rwxr-xr-x | regress/base/lock.pl | 41 |
3 files changed, 26 insertions, 192 deletions
diff --git a/fml/lib/FML/Lock.pm b/fml/lib/FML/Lock.pm deleted file mode 100644 index 973f7cf7..00000000 --- a/fml/lib/FML/Lock.pm +++ /dev/null @@ -1,171 +0,0 @@ -#-*- perl -*- -# -# Copyright (C) 2000 Ken'ichi Fukamachi -# -# $Id$ -# $FML$ -# - -package FML::Lock; - -use vars qw(%LockedFileHandle %FileIsLocked @ISA $Error); -use strict; -use Carp; - -=head1 NAME - -FML::Lock - simple lock by flock(2) - -=head1 SYNOPSIS - - require FML::Lock; - my $lockobj = new FML::Lock; - $lockobj->lock( { file => $lock_file } ) || croak "fail to lock"; - - ... do someting under locking ... - - $lockobj->unlock( { file => $lock_file } ) || croak "fail to unlock"; - -=head1 DESCRIPTION - -FML::Lock.pm contains several interfaces for several files, -for example, Lockfiles, sysLock() (not yet implemented). - -=item Lock( $message ) - -The argument is the message to Lock. - -=cut - -require Exporter; -@ISA = qw(Exporter); - - -# constants -use POSIX qw(EAGAIN ENOENT EEXIST O_EXCL O_CREAT O_RDONLY O_WRONLY); -sub LOCK_SH {1;} -sub LOCK_EX {2;} -sub LOCK_NB {4;} -sub LOCK_UN {8;} - - -sub new -{ - my ($self) = @_; - my ($type) = ref($self) || $self; - my $me = {}; - return bless $me, $type; -} - - -sub _error_reason -{ - my $msg = @_; - $Error = $msg; -} - - -sub error -{ - my ($self) = @_; - $Error; -} - - -sub lock -{ - my ($self, $args) = @_; - - my $file = $args->{ file }; - _simple_flock($file); -} - - -sub unlock -{ - my ($self, $args) = @_; - - my $file = $args->{ file }; - _simple_funlock($file); -} - - - -sub _simple_flock -{ - my ($file) = @_; - - use FileHandle; - my $fh = new FileHandle $file; - - if (defined $fh) { - $LockedFileHandle{ $file } = $fh; - - my $r = 0; # return value - eval q{ - $r = flock($fh, &LOCK_EX); - }; - _error_reason($@) if $@; - - if ($r) { - $FileIsLocked{ $file } = 1; - return 1; - } - } - else { - _error_reason("cannot open $file"); - } - - return 0; -} - - -sub _simple_funlock -{ - my ($file) = @_; - - return 0 unless $FileIsLocked{ $file }; - return 0 unless $LockedFileHandle{ $file }; - - my $fh = $LockedFileHandle{ $file }; - - my $r = 0; # return value - eval q{ - $r = flock($fh, &LOCK_UN); - }; - _error_reason($@) if $@; - - if ($r) { - delete $FileIsLocked{ $file }; - delete $LockedFileHandle{ $file }; - return 1; - } - - return 0; -} - - -=head1 SEE ALSO - -L<FileHandle> - -=head1 AUTHOR - -Ken'ichi Fukamachi <F<fukachan@fml.org>> - -=head1 COPYRIGHT - -Copyright (C) 2000 Ken'ichi Fukamachi - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 HISTORY - -FML::Lock appeared in fml5 mailing list driver package. -See C<http://www.fml.org/> for more details. - -=cut - - -1; diff --git a/fml/lib/FML/Process/Kernel.pm b/fml/lib/FML/Process/Kernel.pm index 83110fde..04d04dd4 100644 --- a/fml/lib/FML/Process/Kernel.pm +++ b/fml/lib/FML/Process/Kernel.pm @@ -19,7 +19,7 @@ use FML::Parse; use FML::Header; use FML::Config; use FML::Log qw(Log); -use FML::Lock; +use File::SimpleLock; use FML::Messages; @@ -117,8 +117,8 @@ sub lock } } - require FML::Lock; - my $lockobj = new FML::Lock; + require File::SimpleLock; + my $lockobj = new File::SimpleLock; return 0 unless $lock_file ; my $r = $lockobj->lock( { file => $lock_file } ); diff --git a/regress/base/lock.pl b/regress/base/lock.pl index 562a9357..e6589022 100755 --- a/regress/base/lock.pl +++ b/regress/base/lock.pl @@ -1,22 +1,27 @@ -if ($0 eq __FILE__) { - use FML::Lock; - my $lockobj = new FML::Lock; +#!/usr/local/bin/perl +# +# $Id$ +# - my $r = $lockobj->lock( { file => '/tmp/a' }); - if ($r) { - print STDERR "lock ($$) ... ok\n"; - } - else { - print STDERR $lockobj->error, "\n"; - } +use File::SimpleLock; +my $lockobj = new File::SimpleLock; - sleep 1; +my $r = $lockobj->lock( { file => '/tmp/a' }); +if ($r) { + print STDERR "lock ($$) ... ok\n"; +} +else { + print STDERR $lockobj->error, "\n"; +} + +sleep 1; - $r = $lockobj->unlock( { file => '/tmp/a' }); - if ($r) { - print STDERR "unlock ... ok\n"; - } - else { - print STDERR $lockobj->error, "\n"; - } +$r = $lockobj->unlock( { file => '/tmp/a' }); +if ($r) { + print STDERR "unlock ... ok\n"; } +else { + print STDERR $lockobj->error, "\n"; +} + +exit 0; |