--- loncom/LONCAPA.pm 2006/06/27 14:49:29 1.9 +++ 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.9 2006/06/27 14:49:29 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 # @@ -40,17 +40,9 @@ my $loncapa_max_wait_time = 13; require Exporter; our @ISA = qw (Exporter); -our @EXPORT = qw(&escape_LaTeX &add_get_param &escape &unescape &tie_domain_hash &untie_domain_hash &tie_user_hash &untie_user_hash &propath); +our @EXPORT = qw(&add_get_param &escape &unescape &tie_domain_hash &untie_domain_hash &tie_user_hash &untie_user_hash &propath); my %perlvar; -# Escape a LaTeX string of special characters that according to LaTeX line by line -# pg 9 are: # $ % & \ ^ _ { } ~ These are escaped by prepending a \ -# -sub escape_LaTeX { - my ($string) = @_; - $string =~ s/[\#\$\%\&\\^_{}]/\\$&/g; - return $string; -} # Inputs are a url, and a hash ref of @@ -228,11 +220,30 @@ 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, this is unsupportted'); + die('Nested locking attempted without proper use of push_locking_hash_tie, this is unsupported'); } my $lock_type=LOCK_SH; @@ -246,6 +257,7 @@ 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 @@ -253,11 +265,14 @@ sub _do_hash_untie { } # Do a shared lock 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 (-e "$file_prefix.db.gz" + || !-e "$file_prefix.db.old" ) { if (!&flock_sym(LOCK_EX)) { + &clean_sym(); return undef; } } @@ -266,6 +281,7 @@ sub _do_hash_untie { open($sym,">>$file_prefix.db.lock"); # Writing needs exclusive lock if (!&flock_sym(LOCK_EX)) { + &clean_sym(); return undef; } } else { @@ -279,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 { @@ -311,7 +356,7 @@ sub _do_hash_untie { my $result = untie(%$hashref); flock($sym,LOCK_UN); close($sym); - undef($sym); + &clean_sym(); return $result; } }