create File:: class outside of FML::snap-20010220

1 files changed, 171 insertions, 0 deletions

diff --git a/fml/lib/File/SimpleLock.pm b/fml/lib/File/SimpleLock.pm
new file mode 100644
index 00000000..1afa0b3c
--- /dev/null
+++ b/fml/lib/File/SimpleLock.pm
@@ -0,0 +1,171 @@
+#-*- perl -*- 
+# 
+# Copyright (C) 2000 Ken'ichi Fukamachi 
+# 
+# $Id$ 
+# $FML$ 
+#
+
+package File::SimpleLock;
+
+use vars qw(%LockedFileHandle %FileIsLocked @ISA $Error);
+use strict;
+use Carp;
+
+=head1 NAME
+
+File::SimpleLock - simple lock by flock(2)
+
+=head1 SYNOPSIS
+
+    require File::SimpleLock;
+    my $lockobj = new File::SimpleLock;
+    $lockobj->lock( { file => $lock_file } ) || croak "fail to lock";
+
+       ... do someting under locking ...
+
+    $lockobj->unlock( { file => $lock_file } ) || croak "fail to unlock";
+
+=head1 DESCRIPTION
+
+File::SimpleLock.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
+
+File::SimpleLock appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;