--- loncom/LONCAPA.pm 2006/05/30 19:26:34 1.4 +++ loncom/LONCAPA.pm 2006/06/27 14:49:29 1.9 @@ -1,7 +1,7 @@ # The LearningOnline Network # Base routines # -# $Id: LONCAPA.pm,v 1.4 2006/05/30 19:26:34 albertel Exp $ +# $Id: LONCAPA.pm,v 1.9 2006/06/27 14:49:29 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,9 +40,19 @@ my $loncapa_max_wait_time = 13; require Exporter; 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); +our @EXPORT = qw(&escape_LaTeX &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 # form name => value pairs # takes care of properly adding the form name elements and values to the @@ -167,6 +177,27 @@ sub untie_user_hash { return &_locking_hash_untie(@_); } +# routines if you just have a filename +# return tied hashref or undef + +sub locking_hash_tie { + my ($filename,$how)=@_; + my ($file_prefix,$namespace)=&db_filename_parts($filename); + if ($namespace eq '') { return undef; } + return &_locking_hash_tie($file_prefix,$namespace,$how); +} + +sub locking_hash_untie { + return &_locking_hash_untie(@_); +} + +sub db_filename_parts { + my ($filename)=@_; + my ($file_path,$namespace)=($filename=~/^(.*)\/([^\/]+)\.db$/); + if ($namespace eq '') { return undef; } + return ($file_path.'/'.$namespace,$namespace); +} + # internal routines that handle the actual tieing and untieing process sub _do_hash_tie { @@ -176,11 +207,10 @@ sub _do_hash_tie { # If this is a namespace for which a history is kept, # make the history log entry: if (($namespace !~/^nohist\_/) && (defined($loghead))) { - my $args = scalar @_; my $hfh = IO::File->new(">>$file_prefix.hist"); if($hfh) { - my $now = time; - print $hfh "$loghead:$now:$what\n"; + my $now = time(); + print $hfh ("$loghead:$now:$what\n"); } $hfh->close; } @@ -201,6 +231,10 @@ sub _do_hash_untie { sub _locking_hash_tie { my ($file_prefix,$namespace,$how,$loghead,$what) = @_; + if (defined($sym)) { + die('Nested locking attempted, this is unsupportted'); + } + my $lock_type=LOCK_SH; # Are we reading or writing? if ($how eq &GDBM_READER()) { @@ -218,19 +252,24 @@ sub _do_hash_untie { open($sym,">>$file_prefix.db.lock"); } # Do a shared lock - if (!&flock_sym(LOCK_SH)) { return undef; } + if (!&flock_sym(LOCK_SH)) { + 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 (!&flock_sym(LOCK_EX)) { + 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)) { + return undef; + } } else { - &logthis("Unknown method $how for $file_prefix"); - die(); + die("Unknown method $how for $file_prefix"); } # The file is ours! # If it is archived, un-archive it now