--- loncom/misc/archive_old_files.pl	2006/05/13 01:35:44	1.2
+++ loncom/misc/archive_old_files.pl	2006/05/18 02:17:30	1.3
@@ -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 @@ system ("find /home/httpd/lonUsers/ -nam
 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);