[LON-CAPA-cvs] cvs: loncom / lond /misc archive_old_files.pl
www
lon-capa-cvs@mail.lon-capa.org
Thu, 18 May 2006 02:17:31 -0000
www Wed May 17 22:17:31 2006 EDT
Modified files:
/loncom lond
/loncom/misc archive_old_files.pl
Log:
Saving my work: new locking and zipping/unzipping mechanism
Index: loncom/lond
diff -u loncom/lond:1.326 loncom/lond:1.327
--- loncom/lond:1.326 Fri May 12 21:31:15 2006
+++ loncom/lond Wed May 17 22:17:27 2006
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.326 2006/05/13 01:31:15 www Exp $
+# $Id: lond,v 1.327 2006/05/18 02:17:27 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -37,7 +37,6 @@
use IO::Socket;
use IO::File;
#use Apache::File;
-use Symbol;
use POSIX;
use Crypt::IDEA;
use LWP::UserAgent();
@@ -54,7 +53,6 @@
use LONCAPA::lonlocal;
use LONCAPA::lonssl;
use Fcntl qw(:flock);
-use Symbol;
my $DEBUG = 0; # Non zero to enable debug log entries.
@@ -62,7 +60,7 @@
my $lastlog='';
my $lond_max_wait_time = 13;
-my $VERSION='$Revision: 1.326 $'; #' stupid emacs
+my $VERSION='$Revision: 1.327 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1050,84 +1048,61 @@
sub _locking_hash_tie {
my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
-
-# is this locked by an external program?
-
- if (-e "$file_prefix.db.lock") {
- my $failed=0;
- eval {
- local $SIG{__DIE__}='DEFAULT';
- local $SIG{ALRM}=sub {
- $failed=1;
- die("failed lock");
- };
- alarm(2*$lond_max_wait_time);
- while (-e "$file_prefix.db.lock") {}
- alarm(0);
- };
- if ($failed) {
- $! = 100; # throwing error # 100
- return undef;
- }
- }
-
-# is this archived?
-
- if (-e "$file_prefix.db.gz") {
-# lock immediately
- open(TOUCH,">>$file_prefix.db.lock");
- close(TOUCH);
+ my $lock_type=LOCK_SH;
+# Are we reading or writing?
+ if ($how eq &GDBM_READER()) {
+# We are reading
+ unless (open($sym,"$file_prefix.db.lock")) {
+# We don't have a lock file. This could mean
+# - that there is no such db-file
+# - that it does not have a lock file yet
+ unless ((-e "$file_prefix.db") || (-e "$file_prefix.db.gz")) {
+# No such file. Forget it.
+ $! = 2;
+ return undef;
+ }
+# Apparently just no lock file yet. Make one
+ open($sym,">>$file_prefix.db.lock");
+ }
+ } elsif ($how eq &GDBM_WRCREAT()) {
+# We are writing
+ open($sym,">>$file_prefix.db.lock");
+# Writing needs exclusive lock
+ $lock_type=LOCK_EX;
+ } else {
+ &logthis("Unknown method $how for $file_prefix");
+ die();
+ }
+# If this is compressed, we will also need an exclusive lock
+ if (-e "$file_prefix.db.gz") { $lock_type=LOCK_EX; }
+# Okay, try to obtain the lock we want
+ my $failed=0;
+ eval {
+ local $SIG{__DIE__}='DEFAULT';
+ local $SIG{ALRM}=sub {
+ $failed=1;
+ die("failed lock");
+ };
+ alarm($lond_max_wait_time);
+ flock($sym,$lock_type);
+ alarm(0);
+ };
+ if ($failed) {
+ $! = 100; # throwing error # 100
+ return undef;
+ }
+# The file is ours!
+# If it is archived, un-archive it now
+ if (-e "$file_prefix.db.gz") {
system("gunzip $file_prefix.db.gz");
if (-e "$file_prefix.hist.gz") {
system("gunzip $file_prefix.hist.gz");
}
-# all set, unlock
- unlink("$file_prefix.db.lock");
}
-
-
- my ($lock);
-
- if ($how eq &GDBM_READER()) {
- $lock=LOCK_SH;
- $how=$how|&GDBM_NOLOCK();
- #if the db doesn't exist we can't read from it
- if (! -e "$file_prefix.db") {
- $! = 2;
- return undef;
- }
- } elsif ($how eq &GDBM_WRCREAT()) {
- $lock=LOCK_EX;
- $how=$how|&GDBM_NOLOCK();
- if (! -e "$file_prefix.db") {
- # doesn't exist but we need it to in order to successfully
- # lock it so bring it into existance
- open(TOUCH,">>$file_prefix.db");
- close(TOUCH);
- }
- } else {
- &logthis("Unknown method $how for $file_prefix");
- die();
- }
-
- $sym=&Symbol::gensym();
- open($sym,"$file_prefix.db");
- my $failed=0;
- eval {
- local $SIG{__DIE__}='DEFAULT';
- local $SIG{ALRM}=sub {
- $failed=1;
- die("failed lock");
- };
- alarm($lond_max_wait_time);
- flock($sym,$lock);
- alarm(0);
- };
- if ($failed) {
- $! = 100; # throwing error # 100
- return undef;
- }
- return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
+# Change access mode to non-blocking
+ $how=$how|&GDBM_NOLOCK();
+# Go ahead and tie the hash
+ return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
}
sub _locking_hash_untie {
@@ -6668,7 +6643,6 @@
IO::Socket
IO::File
Apache::File
-Symbol
POSIX
Crypt::IDEA
LWP::UserAgent()
Index: loncom/misc/archive_old_files.pl
diff -u loncom/misc/archive_old_files.pl:1.2 loncom/misc/archive_old_files.pl:1.3
--- loncom/misc/archive_old_files.pl:1.2 Fri May 12 21:35:44 2006
+++ loncom/misc/archive_old_files.pl Wed May 17 22:17:30 2006
@@ -2,7 +2,7 @@
# The LearningOnline Network
# zip all .db and .hist files that have not been accessed in 120 days
#
-# $Id: archive_old_files.pl,v 1.2 2006/05/13 01:35:44 www Exp $
+# $Id: archive_old_files.pl,v 1.3 2006/05/18 02:17:30 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,6 +27,7 @@
# http://www.lon-capa.org/
#
#################################################
+use Fcntl qw(:flock);
my $oldfile="/home/httpd/perl/tmp/old_files.lst";
system ("find /home/httpd/lonUsers/ -name *.db -atime +120 > $oldfile");
@@ -34,16 +35,20 @@
open(IN,$oldfile);
while (my $dbfile=<IN>) {
chomp($dbfile);
- if (-e "$dbfile.lock") { next; }
- open(TOUCH,">>$dbfile.lock");
- close(TOUCH);
+ my $sym;
+ open($sym,">>$dbfile.lock");
+ unless (flock($sym,(LOCK_EX|LOCK_NB))) {
+ close($sym);
+ next;
+ }
system("gzip $dbfile");
my $histfile=$dbfile;
$histfile=~s/\.db$/\.hist/;
if (-e $histfile) {
system("gzip $histfile");
}
- unlink("$dbfile.lock");
+ flock($sym,LOCK_UN);
+ close($sym);
}
close(IN);
unlink($oldfile);