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