First pass at adding key files

site/slowtwitch.com/cgi-bin/articles/admin/GT/Lock.pm

@@ -0,0 +1,178 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::Lock
+#   Author: Scott Beck
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Lock.pm,v 1.7 2007/02/11 21:56:56 sbeck Exp $
+#
+# Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description: a small autonomous locking module.
+#
+package GT::Lock;
+
+use vars qw/@EXPORT_OK $error $SAFETY $ERRORS/;
+use strict;
+use bases
+    'Exporter' => '',
+    'GT::Base' => '';
+
+use constants
+    MASK       => 0777,
+    SLEEPTIME  => 0.05,
+    TIMEOUT    => 10,
+    LOCK_TRY   => 1,
+    LOCK_FORCE => 2;
+
+use POSIX qw/errno_h/;
+use GT::TempFile;
+
+$ERRORS = {
+    'TIMEOUT' => 'Could not lock %s; We timed out',
+    'NOLOCK'  => 'No lock was found for name %s'
+};
+@EXPORT_OK = qw/lock unlock LOCK_FORCE LOCK_TRY/;
+
+sub lock {
+#---------------------------------------------------------------------------------
+    defined( $_[0] ) or GT::Lock->fatal( BADARGS => 'First argument must be a defined value' );
+    my $name       = escape($_[0]);
+    my $timeout    = defined $_[1] ? $_[1] : TIMEOUT;
+    my $opt        = defined $_[2] ? $_[2] : LOCK_FORCE;
+    my $max_age    = $_[3];
+    my $tmp_dir    = $GT::TempFile::TMP_DIR || GT::TempFile::find_tmpdir();
+    my $lock_dir   = "$tmp_dir/$name";
+    if ($max_age and -d $lock_dir and time - (stat $lock_dir)[9] > $max_age) {
+        rmdir $lock_dir or $! == ENOENT or GT::Lock->fatal(RMDIR => $lock_dir, "$!");
+    }
+    my $start_time = time;
+    until (mkdir $lock_dir, MASK) {
+        select undef, undef, undef, SLEEPTIME;
+        if ($timeout and $start_time + $timeout < time) {
+            if ($opt == LOCK_TRY) {
+                return GT::Lock->warn(TIMEOUT => unescape($name));
+            }
+            else {
+                # XXX - 2 appears to be No such file or directory, but may not be entirely portable.
+                unless (rmdir $lock_dir and $! != ENOENT) {
+                    # The rmdir failed which *may* be due to two processes
+                    # holding the same lock then the other one deleting it
+                    # just before this one attempted to.  In such a case, we
+                    # allow double the timeout to try to avoid the race -
+                    # though this reduces the frequency of race conditions, it
+                    # does not completely eliminate it.
+                    if ($timeout and $start_time + 2 * $timeout < time) {
+                        GT::Lock->fatal(RMDIR => $lock_dir, "$!");
+                    }
+                }
+            }
+        }
+    }
+    return 1;
+}
+
+sub unlock {
+#--------------------------------------------------------------------------------
+    my $name     = escape($_[0]);
+    my $tmp_dir  = $GT::TempFile::TMP_DIR || GT::TempFile::find_tmpdir();
+    my $lock_dir = "$tmp_dir/$name";
+    if (-d $lock_dir) {
+        rmdir $lock_dir or return GT::Lock->fatal(RMDIR => $lock_dir, "$!");
+    }
+    else {
+        return GT::Lock->warn(NOLOCK => $name);
+    }
+    return 1;
+}
+
+sub escape {
+#--------------------------------------------------------------------------------
+    my $toencode = $_[0];
+    return unless (defined $toencode);
+    $toencode    =~ s/([^\w. -])/sprintf "%%%02X", ord $1/eg;
+    $toencode    =~ s/ /%20/g;
+    return $toencode;
+}
+
+sub unescape {
+#--------------------------------------------------------------------------------
+    my $todecode = $_[0];
+    return unless (defined $todecode);
+    $todecode    =~ tr/+/ /;       # pluses become spaces
+    $todecode    =~ s/%([0-9a-fA-F]{2})/chr hex $1/ge;
+    return $todecode;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+GT::Lock - a small autonomous locking module.
+
+=head2 SYNOPSIS
+
+    use GT::Lock qw/lock unlock LOCK_TRY LOCK_FORCE/;
+
+    # attempt to lock foobar for 10 seconds
+    if (lock 'foobar', 10, LOCK_TRY) {
+        # do some code that needs to be locked
+        unlock 'foobar';
+    }
+    else {
+        # oops out lock failed
+        die "Lock failed: $GT::Lock::error\n";
+    }
+
+=head1 DESCRIPTION
+
+GT::Lock is a very simple module to impliment autonomous named locking. Locking
+can be used for many things but is most commonly used to lock files for IO to
+them.
+
+Nothing is exported by default. You may request the lock, unlock routines be
+exported. You can also get the two constants for lock types exported:
+C<LOCK_TRY> and C<LOCK_FORCE>.
+
+=head2 lock - Lock a name.
+
+    lock NAME [, TIMOUT, TYPE, AGE ]
+
+This method is used to create a lock.  Its arguments are the name you wish to
+give the lock, the timeout in seconds for the lock to happen, the type of lock,
+and the maximum lock age (in seconds).  The types are C<LOCK_FORCE> and
+C<LOCK_TRY>.  If C<LOCK_FORCE> is given a lock always succeeds, e.g. if the
+lock times out the lock is removed and your lock succeeds.  Try attempts to get
+the lock and returns false if the lock can not be had in the specified
+C<TIMEOUT>.  If C<TIMEOUT> is zero this method will attempt to lock forever.
+C<TIMEOUT> defaults to 10 seconds.  The AGE parameter can be used to ensure
+that stale locks are not preserved - if the lock already exists and is older
+than AGE seconds, it will be removed before attempting to get the lock.
+Omitting it uses the default value, undef, which does not attempt to remove
+stale locks.
+
+=head2 unlock - unlock a name.
+
+    unlock NAME
+
+This method is used to unlock a name. It's argument is the name of the lock to
+unlock. Returns true on success and false on errors and sets the error in
+$GT::Lock::error.
+
+=head1 DEPENDANCIES
+
+L<GT::Lock> depends on L<GT::TempFile>, L<bases>, and L<constants>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
+http://www.gossamer-threads.com/
+
+=head1 VERSION
+
+Revision: $Id: Lock.pm,v 1.7 2007/02/11 21:56:56 sbeck Exp $
+
+=cut