version 1.10, 2006/06/27 15:21:28
|
version 1.13, 2006/08/11 20:07:18
|
Line 40 my $loncapa_max_wait_time = 13;
|
Line 40 my $loncapa_max_wait_time = 13;
|
|
|
require Exporter; |
require Exporter; |
our @ISA = qw (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; |
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 |
# Inputs are a url, and a hash ref of |
Line 229 sub _do_hash_untie {
|
Line 221 sub _do_hash_untie {
|
{ |
{ |
my $sym; |
my $sym; |
my @pushed_syms; |
my @pushed_syms; |
|
|
|
sub clean_sym { |
|
undef($sym); |
|
} |
sub push_locking_hash_tie { |
sub push_locking_hash_tie { |
if (!defined($sym)) { |
if (!defined($sym)) { |
die("Invalid used of push_locking_hash_tie, should only be called after a lock has occurred and before and unlock."); |
die("Invalid used of push_locking_hash_tie, should only be called after a lock has occurred and before and unlock."); |
Line 247 sub _do_hash_untie {
|
Line 243 sub _do_hash_untie {
|
sub _locking_hash_tie { |
sub _locking_hash_tie { |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
if (defined($sym)) { |
if (defined($sym)) { |
die('Nested locking attempted withut proper use of push_locking_hahs_tie, this is unsupportted'); |
die('Nested locking attempted without proper use of push_locking_hash_tie, this is unsupported'); |
} |
} |
|
|
my $lock_type=LOCK_SH; |
my $lock_type=LOCK_SH; |
Line 261 sub _do_hash_untie {
|
Line 257 sub _do_hash_untie {
|
if ((! -e "$file_prefix.db") && (! -e "$file_prefix.db.gz")) { |
if ((! -e "$file_prefix.db") && (! -e "$file_prefix.db.gz")) { |
# No such file. Forget it. |
# No such file. Forget it. |
$! = 2; |
$! = 2; |
|
&clean_sym(); |
return undef; |
return undef; |
} |
} |
# Apparently just no lock file yet. Make one |
# Apparently just no lock file yet. Make one |
Line 268 sub _do_hash_untie {
|
Line 265 sub _do_hash_untie {
|
} |
} |
# Do a shared lock |
# Do a shared lock |
if (!&flock_sym(LOCK_SH)) { |
if (!&flock_sym(LOCK_SH)) { |
|
&clean_sym(); |
return undef; |
return undef; |
} |
} |
# If this is compressed, we will actually need an exclusive lock |
# If this is compressed, we will actually need an exclusive lock |
if (-e "$file_prefix.db.gz") { |
if (-e "$file_prefix.db.gz") { |
if (!&flock_sym(LOCK_EX)) { |
if (!&flock_sym(LOCK_EX)) { |
|
&clean_sym(); |
return undef; |
return undef; |
} |
} |
} |
} |
Line 281 sub _do_hash_untie {
|
Line 280 sub _do_hash_untie {
|
open($sym,">>$file_prefix.db.lock"); |
open($sym,">>$file_prefix.db.lock"); |
# Writing needs exclusive lock |
# Writing needs exclusive lock |
if (!&flock_sym(LOCK_EX)) { |
if (!&flock_sym(LOCK_EX)) { |
|
&clean_sym(); |
return undef; |
return undef; |
} |
} |
} else { |
} else { |
Line 297 sub _do_hash_untie {
|
Line 297 sub _do_hash_untie {
|
# Change access mode to non-blocking |
# Change access mode to non-blocking |
$how=$how|&GDBM_NOLOCK(); |
$how=$how|&GDBM_NOLOCK(); |
# Go ahead and tie the hash |
# 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 { |
sub flock_sym { |
Line 326 sub _do_hash_untie {
|
Line 331 sub _do_hash_untie {
|
my $result = untie(%$hashref); |
my $result = untie(%$hashref); |
flock($sym,LOCK_UN); |
flock($sym,LOCK_UN); |
close($sym); |
close($sym); |
undef($sym); |
&clean_sym(); |
return $result; |
return $result; |
} |
} |
} |
} |