--- loncom/LONCAPA.pm 2006/06/19 10:00:27 1.7 +++ loncom/LONCAPA.pm 2006/10/13 19:11:05 1.13.2.1 @@ -1,7 +1,7 @@ # The LearningOnline Network # Base routines # -# $Id: LONCAPA.pm,v 1.7 2006/06/19 10:00:27 albertel Exp $ +# $Id: LONCAPA.pm,v 1.13.2.1 2006/10/13 19:11:05 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,6 +43,8 @@ our @ISA = qw (Exporter); our @EXPORT = qw(&add_get_param &escape &unescape &tie_domain_hash &untie_domain_hash &tie_user_hash &untie_user_hash &propath); my %perlvar; + + # Inputs are a url, and a hash ref of # form name => value pairs # takes care of properly adding the form name elements and values to the @@ -218,9 +220,32 @@ sub _do_hash_untie { { my $sym; + my @pushed_syms; + + sub clean_sym { + undef($sym); + } + sub push_locking_hash_tie { + if (!defined($sym)) { + die("Invalid used of push_locking_hash_tie, should only be called after a lock has occurred and before and unlock."); + } + push(@pushed_syms,$sym); + undef($sym); + } + + sub pop_locking_hash_tie { + if (defined($sym)) { + die("Invalid nested used of pop_locking_hash_tie, should only be called after a unlock has occurred."); + } + $sym = pop(@pushed_syms); + } sub _locking_hash_tie { my ($file_prefix,$namespace,$how,$loghead,$what) = @_; + if (defined($sym)) { + die('Nested locking attempted without proper use of push_locking_hash_tie, this is unsupported'); + } + my $lock_type=LOCK_SH; # Are we reading or writing? if ($how eq &GDBM_READER()) { @@ -232,22 +257,33 @@ sub _do_hash_untie { if ((! -e "$file_prefix.db") && (! -e "$file_prefix.db.gz")) { # No such file. Forget it. $! = 2; + &clean_sym(); return undef; } # Apparently just no lock file yet. Make one open($sym,">>$file_prefix.db.lock"); } # Do a shared lock - if (!&flock_sym(LOCK_SH)) { return undef; } + if (!&flock_sym(LOCK_SH)) { + &clean_sym(); + return undef; + } # If this is compressed, we will actually need an exclusive lock - if (-e "$file_prefix.db.gz") { - if (!&flock_sym(LOCK_EX)) { return undef; } + if (-e "$file_prefix.db.gz" + || !-e "$file_prefix.db.old" ) { + if (!&flock_sym(LOCK_EX)) { + &clean_sym(); + return undef; + } } } elsif ($how eq &GDBM_WRCREAT()) { # We are writing open($sym,">>$file_prefix.db.lock"); # Writing needs exclusive lock - if (!&flock_sym(LOCK_EX)) { return undef; } + if (!&flock_sym(LOCK_EX)) { + &clean_sym(); + return undef; + } } else { die("Unknown method $how for $file_prefix"); } @@ -259,10 +295,39 @@ sub _do_hash_untie { system("gunzip $file_prefix.hist.gz"); } } + if (!-e "$file_prefix.db.old") { + my $dump_db = '/home/httpd/perl/debug/dump_db_static_32'; + my $create_db = '/home/httpd/perl/debug/create_db_dynamic_64'; + my $file = "$file_prefix.db"; + &main::logthis("Converting $file"); + if (!-x $dump_db) { + &clean_symb(); + &main::logthis("$dump_db unexecutable"); + return; + } + if (!-x $create_db) { + &clean_symb(); + &main::logthis("$create_db unexecutable"); + return; + } + system("$dump_db -f $file|$create_db -f $file.new"); + if (!-e "$file.new") { + &clean_symb(); + &main::logthis("conversion faile $file.new doesn't exist"); + return; + } + rename($file,"$file.old"); + rename("$file.new","$file"); + } # 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); + my $result = + &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); + if (!$result) { + &clean_sym(); + } + return $result; } sub flock_sym { @@ -291,7 +356,7 @@ sub _do_hash_untie { my $result = untie(%$hashref); flock($sym,LOCK_UN); close($sym); - undef($sym); + &clean_sym(); return $result; } }