import lock mechanism from File::SimpleLock class. Now IO::Adapter

provides lock() and unlock() metohds though file map only is
supported.

FML::Process::Kernel is switched to IO::Adapter based lock.

3 files changed, 232 insertions, 3 deletions

diff --git a/fml/lib/IO/Adapter.pm b/fml/lib/IO/Adapter.pm
index 4ad26f6a..fc913f2f 100644
--- a/fml/lib/IO/Adapter.pm
+++ b/fml/lib/IO/Adapter.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Adapter.pm,v 1.29 2004/02/03 04:15:32 fukachan Exp $
+# $FML: Adapter.pm,v 1.30 2004/02/15 04:38:35 fukachan Exp $
 #
 
 package IO::Adapter;
@@ -288,6 +288,47 @@ sub touch
 }
 
 
+=head2 lock()
+
+lock. currently, only supported for file map.
+
+=head2 unlock()
+
+unlock. currently, only supported for file map.
+
+=cut
+
+
+# Descriptions: create a file if not exists.
+#    Arguments: OBJ($self)
+# Side Effects: create $map if needed or possible
+# Return Value: none
+sub lock
+{
+    my ($self) = @_;
+    my $type   = $self->{ _type };
+
+    if ($type eq 'file') {
+	$self->SUPER::lock( { file => $self->{_file} } );
+    }
+}
+
+
+# Descriptions: create a file if not exists.
+#    Arguments: OBJ($self)
+# Side Effects: create $map if needed or possible
+# Return Value: none
+sub unlock
+{
+    my ($self) = @_;
+    my $type   = $self->{ _type };
+
+    if ($type eq 'file') {
+	$self->SUPER::unlock( { file => $self->{_file} } );
+    }
+}
+
+
 =head2 methods to retrieve data
 
 get_next_key() is used to get the next primary key incrementally.
diff --git a/fml/lib/IO/Adapter/File.pm b/fml/lib/IO/Adapter/File.pm
index 93dd6c80..806e5ec4 100644
--- a/fml/lib/IO/Adapter/File.pm
+++ b/fml/lib/IO/Adapter/File.pm
@@ -4,13 +4,14 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: File.pm,v 1.52 2004/02/03 04:15:33 fukachan Exp $
+# $FML: File.pm,v 1.53 2004/03/17 06:58:43 fukachan Exp $
 #
 
 package IO::Adapter::File;
 
 use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD
+	    %LockedFileHandle %FileIsLocked);
 use Carp;
 use IO::Adapter::ErrorStatus qw(error_set error error_clear);
 
@@ -167,7 +168,9 @@ sub touch
 }
 
 
+#
 # debug tools
+#
 my $c  = 0;
 my $ec = 0;
 
@@ -462,6 +465,113 @@ sub delete
 }
 
 
+=head1 LOCK
+
+=head2 lock($args)
+
+=head2 unlock($args)
+
+=cut
+
+
+# Descriptions: flock file (create a file if needed).
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: create a file if needed.
+# Return Value: none
+sub lock
+{
+    my ($self, $args) = @_;
+    my $file = $args->{ file };
+
+    $self->_simple_flock($file);
+}
+
+
+# Descriptions: un-flock file (create a file if needed).
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub unlock
+{
+    my ($self, $args) = @_;
+    my $file = $args->{ file };
+
+    $self->_simple_funlock($file);
+}
+
+
+# Descriptions: try flock(2) for $file.
+#    Arguments: OBJ($self) STR($file)
+# Side Effects: flock for $file
+# Return Value: 1 or 0
+sub _simple_flock
+{
+    my ($self, $file) = @_;
+
+    use FileHandle;
+    my $fh = new FileHandle ">> $file";
+
+    if (defined $fh) {
+	print STDERR "\tdebug[$$]: try lock $file\n" if $debug;
+
+	$LockedFileHandle{ $file } = $fh;
+
+	my $r = 0; # return value
+	eval q{
+	    use Fcntl qw(:DEFAULT :flock);
+	    $r = flock($fh, &LOCK_EX);
+	};
+	$self->error_set($@) if $@;
+
+	if ($r) {
+	    print STDERR "\tdebug[$$]: $file LOCKED\n" if $debug;
+	    $FileIsLocked{ $file } = 1;
+	    return 1;
+	}
+    }
+    else {
+	$self->error_set("cannot open $file");
+    }
+
+    return 0;
+}
+
+
+# Descriptions: try unlock by flock(2) for $file.
+#    Arguments: OBJ($self) STR($file)
+# Side Effects: flock for $file
+# Return Value: 1 or 0
+sub _simple_funlock
+{
+    my ($self, $file) = @_;
+
+    print STDERR "\tdebug[$$]: call unlock $file\n" if $debug;
+
+    return 0 unless $FileIsLocked{ $file };
+    return 0 unless $LockedFileHandle{ $file };
+
+    my $fh = $LockedFileHandle{ $file };
+
+    print STDERR "\tdebug[$$]: try unlock $file\n" if $debug;
+
+    my $r = 0; # return value
+    eval q{
+	use Fcntl qw(:DEFAULT :flock);
+	$r = flock($fh, &LOCK_UN);
+    };
+    $self->error_set($@) if $@;
+
+    if ($r) {
+	print STDERR "\tdebug[$$]: $file UNLOCKED\n" if $debug;
+	delete $FileIsLocked{ $file };
+	delete $LockedFileHandle{ $file };
+	return 1;
+    }
+
+    return 0;
+}
+
+
 =head1 SEE ALSO
 
 L<IO::Adapter>
diff --git a/fml/lib/IO/t/lock.pl b/fml/lib/IO/t/lock.pl
new file mode 100755
index 00000000..1093c00e
--- /dev/null
+++ b/fml/lib/IO/t/lock.pl
@@ -0,0 +1,78 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2004 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.
+#
+# $FML: add.pl,v 1.2 2003/07/21 03:43:56 fukachan Exp $
+#
+
+use strict;
+use Carp;
+
+my $debug = 0;
+my $i     = 0;
+my $file  = "/tmp/io.adapter.$$";
+my $map   = "file:$file";
+my %log   = ();
+my %pid   = ();
+
+### MAIN ###
+print "${file}->lock()/unlock()\n";
+
+use IO::Adapter;
+
+for my $i (0 .. 5) {
+    my $obj = new IO::Adapter $map;
+
+    my $pid = fork();
+    $pid{ $pid } = 1;
+    if ($pid == 0) {
+	my $t;
+	my $ok;
+
+	if ($obj->lock()) {
+	    $t = time;
+	    $log{ $i } .= "locked\t";
+	    $ok++;
+	}
+
+	sleep(rand(5));
+	if ($obj->unlock()) {
+	    $t = time - $t;
+	    $log{ $i } .= "$t\tunlocked\n";
+	    $ok++;
+	}
+
+	print STDERR "$i [$$]\t$log{ $i }" if $debug;
+	if ($ok == 2) {
+	    print "ok [$$] (wait for $t sec)\n";
+	}
+	else {
+	    print "fail [$$] (wait for $t sec)\n";
+	}
+
+	exit(0);
+    }
+}
+
+# Wait for the child to terminate.
+{
+    my $dying;
+
+  WAIT:
+    while (($dying = wait()) != -1) {
+	$pid{ $dying } = 0;
+
+	my $found = 0;
+	for my $i (keys %pid) {
+	    $found++ if $pid{ $i };
+	}
+
+	last WAIT if $found;
+    }
+}
+
+sleep 20;
+
+exit 0;