[LON-CAPA-cvs] cvs: loncom / lond /misc archive_old_files.pl

[www]

www		Fri May 12 21:31:27 2006 EDT

  Added files:                 
    /loncom/misc	archive_old_files.pl 

  Modified files:              
    /loncom	lond 
  Log:
  Script to archive .db and .hist that have not been accessed in 120 days
  lond automatically unzips them if needed
  
  
Index: loncom/lond
diff -u loncom/lond:1.325 loncom/lond:1.326
--- loncom/lond:1.325	Thu May 11 13:53:22 2006
+++ loncom/lond	Fri May 12 21:31:15 2006
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.325 2006/05/11 17:53:22 albertel Exp $
+# $Id: lond,v 1.326 2006/05/13 01:31:15 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -62,7 +62,7 @@
 my $lastlog='';
 my $lond_max_wait_time = 13;
 
-my $VERSION='$Revision: 1.325 $'; #' stupid emacs
+my $VERSION='$Revision: 1.326 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1051,6 +1051,41 @@
     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);
+           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()) {

Index: loncom/misc/archive_old_files.pl
+++ loncom/misc/archive_old_files.pl
#!/usr/bin/perl
# The LearningOnline Network
# zip all .db and .hist files that have not been accessed in 120 days
#
# $Id: archive_old_files.pl,v 1.1 2006/05/13 01:31:24 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#################################################

my $oldfile="/home/httpd/perl/tmp/old_files.lst";
system ("find /home/httpd/lonUsers/ -name *.db -atime +120 > $oldfile");

open(IN,$oldfile);
while (my $dbfile=<IN>) {
    chomp($dbfile);
    open(TOUCH,">>$dbfile.lock");
    close(TOUCH);
    system("gzip $dbfile");
    my $histfile=$dbfile;
    $histfile=~s/\.db$/\.hist/;
    if (-e $histfile) {
	system("gzip $histfile");
    }
    unlink("$dbfile.lock");
}
close(IN);
unlink($oldfile);