version 1.311, 2006/01/31 15:37:41
|
version 1.312, 2006/01/31 15:56:46
|
Line 971 sub tie_domain_hash {
|
Line 971 sub tie_domain_hash {
|
|
|
my $user_top_dir = $perlvar{'lonUsersDir'}; |
my $user_top_dir = $perlvar{'lonUsersDir'}; |
my $domain_dir = $user_top_dir."/$domain"; |
my $domain_dir = $user_top_dir."/$domain"; |
my $resource_file = $domain_dir."/$namespace.db"; |
my $resource_file = $domain_dir."/$namespace"; |
my %hash; |
return &_do_hash_tie($resource_file,$namespace,$how,$loghead,$logtail); |
if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) { |
|
if (defined($loghead)) { # Need to log the operation. |
|
my $logFh = IO::File->new(">>$domain_dir/$namespace.hist"); |
|
if($logFh) { |
|
my $timestamp = time; |
|
print $logFh "$loghead:$timestamp:$logtail\n"; |
|
} |
|
$logFh->close; |
|
} |
|
return \%hash; # Return the tied hash. |
|
} else { |
|
return undef; # Tie failed. |
|
} |
|
} |
} |
|
|
sub untie_domain_hash { |
sub untie_domain_hash { |
my ($hashref) = @_; |
return &_do_hash_untie(@_); |
untie(%$hashref); |
|
} |
} |
# |
# |
# Ties a user's resource file to a hash. |
# Ties a user's resource file to a hash. |
Line 1017 sub tie_user_hash {
|
Line 1003 sub tie_user_hash {
|
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\W//g; # whitespace eliminated. |
$namespace=~s/\W//g; # whitespace eliminated. |
my $proname = propath($domain, $user); |
my $proname = propath($domain, $user); |
|
|
# Tie the database. |
my $file_prefix="$proname/$namespace"; |
|
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
|
} |
|
|
|
sub untie_user_hash { |
|
return &_do_hash_untie(@_); |
|
} |
|
|
|
# internal routines that handle the actual tieing and untieing process |
|
|
|
sub _do_hash_tie { |
|
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
my %hash; |
my %hash; |
if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", |
if(tie(%hash, 'GDBM_File', "$file_prefix.db", $how, 0640)) { |
$how, 0640)) { |
|
# 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 @_; |
my $args = scalar @_; |
Debug(" Opening history: $namespace $args"); |
Debug(" Opening history: $file_prefix $args"); |
my $hfh = IO::File->new(">>$proname/$namespace.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"; |
Line 1039 sub tie_user_hash {
|
Line 1034 sub tie_user_hash {
|
} else { |
} else { |
return undef; |
return undef; |
} |
} |
|
|
} |
} |
|
|
sub untie_user_hash { |
sub _do_hash_untie { |
my ($hashref) = @_; |
my ($hashref) = @_; |
my $result = untie(%$hashref); |
my $result = untie(%$hashref); |
return $result; |
return $result; |