version 1.2, 2006/05/30 12:45:12
|
version 1.13.2.1, 2006/10/13 19:11:05
|
Line 43 our @ISA = qw (Exporter);
|
Line 43 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(&add_get_param &escape &unescape &tie_domain_hash &untie_domain_hash &tie_user_hash &untie_user_hash &propath); |
my %perlvar; |
my %perlvar; |
|
|
|
|
|
|
# Inputs are a url, and a hash ref of |
# Inputs are a url, and a hash ref of |
# form name => value pairs |
# form name => value pairs |
# takes care of properly adding the form name elements and values to the |
# takes care of properly adding the form name elements and values to the |
Line 167 sub untie_user_hash {
|
Line 169 sub untie_user_hash {
|
return &_locking_hash_untie(@_); |
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 |
# internal routines that handle the actual tieing and untieing process |
|
|
sub _do_hash_tie { |
sub _do_hash_tie { |
Line 176 sub _do_hash_tie {
|
Line 199 sub _do_hash_tie {
|
# If this is a namespace for which a history is kept, |
# If this is a namespace for which a history is kept, |
# make the history log entry: |
# make the history log entry: |
if (($namespace !~/^nohist\_/) && (defined($loghead))) { |
if (($namespace !~/^nohist\_/) && (defined($loghead))) { |
my $args = scalar @_; |
|
Debug(" Opening history: $file_prefix $args"); |
|
my $hfh = IO::File->new(">>$file_prefix.hist"); |
my $hfh = IO::File->new(">>$file_prefix.hist"); |
if($hfh) { |
if($hfh) { |
my $now = time; |
my $now = time(); |
print $hfh "$loghead:$now:$what\n"; |
print $hfh ("$loghead:$now:$what\n"); |
} |
} |
$hfh->close; |
$hfh->close; |
} |
} |
Line 199 sub _do_hash_untie {
|
Line 220 sub _do_hash_untie {
|
|
|
{ |
{ |
my $sym; |
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 { |
sub _locking_hash_tie { |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
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; |
my $lock_type=LOCK_SH; |
# Are we reading or writing? |
# Are we reading or writing? |
if ($how eq &GDBM_READER()) { |
if ($how eq &GDBM_READER()) { |
Line 213 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 |
open($sym,">>$file_prefix.db.lock"); |
open($sym,">>$file_prefix.db.lock"); |
} |
} |
# Do a shared 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 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)) { return undef; } |
|| !-e "$file_prefix.db.old" ) { |
|
if (!&flock_sym(LOCK_EX)) { |
|
&clean_sym(); |
|
return undef; |
|
} |
} |
} |
} elsif ($how eq &GDBM_WRCREAT()) { |
} elsif ($how eq &GDBM_WRCREAT()) { |
# We are writing |
# We are writing |
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)) { return undef; } |
if (!&flock_sym(LOCK_EX)) { |
|
&clean_sym(); |
|
return undef; |
|
} |
} else { |
} else { |
&logthis("Unknown method $how for $file_prefix"); |
die("Unknown method $how for $file_prefix"); |
die(); |
|
} |
} |
# The file is ours! |
# The file is ours! |
# If it is archived, un-archive it now |
# If it is archived, un-archive it now |
Line 241 sub _do_hash_untie {
|
Line 295 sub _do_hash_untie {
|
system("gunzip $file_prefix.hist.gz"); |
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 |
# 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 273 sub _do_hash_untie {
|
Line 356 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; |
} |
} |
} |
} |
|
|
BEGIN { |
BEGIN { |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
%perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')}; |
%perlvar=%{$perlvarref}; |
|
undef $perlvarref; |
|
} |
} |
|
|
1; |
1; |