r6697 - /scripts/qa/versioncheck2.pl

tincho-guest at users.alioth.debian.org tincho-guest at users.alioth.debian.org
Thu Aug 16 03:11:05 UTC 2007


Author: tincho-guest
Date: Thu Aug 16 03:11:05 2007
New Revision: 6697

URL: http://svn.debian.org/wsvn/?sc=1&rev=6697
Log:
Added option to change the cache directory (-cache-dir), and lockfile support, so we can use a shared directory

Modified:
    scripts/qa/versioncheck2.pl

Modified: scripts/qa/versioncheck2.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck2.pl?rev=6697&op=diff
==============================================================================
--- scripts/qa/versioncheck2.pl (original)
+++ scripts/qa/versioncheck2.pl Thu Aug 16 03:11:05 2007
@@ -32,15 +32,18 @@
 use IO::Scalar;
 use Parse::DebianChangelog;
 use Getopt::Long;
+use File::Path;
 
 our $opt_debug = 0;
 my $force_cpan = 0;
 my $force_rescan = 0;
+our $CACHEDIR = "$ENV{HOME}/.dpg/versioncheck";
 
 GetOptions(
-    'debug!'    => \$opt_debug,
+    'debug!'         => \$opt_debug,
     'force-cpan!'    => \$force_cpan,
-    'force-rescan!'    => \$force_rescan,
+    'force-rescan!'  => \$force_rescan,
+    'cache-dir=s'    => \$CACHEDIR
 );
 
 sub debugmsg(@)
@@ -48,6 +51,19 @@
     warn @_ if $opt_debug;
 };
 
+mkpath $CACHEDIR;
+my $lockfile = "$CACHEDIR/.lock";
+if(-e $lockfile) {
+    if(-M $lockfile > 1/24) { # 1 hour
+        debugmsg("Stale lock file -- deleting\n");
+        unlink $lockfile or die $!;
+    } else {
+        die("Other instance of $0 is running!\n");
+    }
+}
+$SIG{__DIE__} = sub { debugmsg("Removing lockfile...\n"); unlink $lockfile };
+open(LOCK, ">", $lockfile) or die $!;
+close(LOCK) or die $!;
 
 # Get some information globally
 
@@ -55,13 +71,13 @@
 use LWP::UserAgent;
 
 debugmsg( "CPAN mirror is $CPAN_MIRROR\n" );
-debugmsg( "HOME=$ENV{HOME}\n" );
+debugmsg( "The cache is in $CACHEDIR\n" );
 
 sub from_cache($$$)
 {
     my( $ref, $name, $max_age) = @_;
 
-    my $dir = $ENV{HOME}.'/.dpg/versioncheck';
+    my $dir = $CACHEDIR;
 
     return undef unless -f "$dir/$name" and -M(_) <= $max_age/24;
 
@@ -78,12 +94,7 @@
 {
     my( $ref, $name) = @_;
 
-    my $home = $ENV{HOME};
-
-    -d "$home/.dpg" or mkdir("$home/.dpg") or die $!;
-    -d "$home/.dpg/versioncheck" or mkdir("$home/.dpg/versioncheck") or die $!;
-
-    Storable::store($ref, "$home/.dpg/versioncheck/$name");
+    Storable::store($ref, "$CACHEDIR/$name");
 }
 
 sub scan_packages($$)
@@ -888,6 +899,6 @@
 
 print $footer;
 
-exit 0;
+unlink $lockfile or die $!;
 
 # vim: et:sts=4:ai:sw=4




More information about the Pkg-perl-cvs-commits mailing list