[LON-CAPA-cvs] cvs: loncom / lond
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 31 Jan 2006 15:56:47 -0000
albertel Tue Jan 31 10:56:47 2006 EDT
Modified files:
/loncom lond
Log:
- making tie_*_hash and untie_*_hash use common routines to do their work
Index: loncom/lond
diff -u loncom/lond:1.311 loncom/lond:1.312
--- loncom/lond:1.311 Tue Jan 31 10:37:41 2006
+++ loncom/lond Tue Jan 31 10:56:46 2006
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.311 2006/01/31 15:37:41 albertel Exp $
+# $Id: lond,v 1.312 2006/01/31 15:56:46 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,7 +59,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.311 $'; #' stupid emacs
+my $VERSION='$Revision: 1.312 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -971,26 +971,12 @@
my $user_top_dir = $perlvar{'lonUsersDir'};
my $domain_dir = $user_top_dir."/$domain";
- my $resource_file = $domain_dir."/$namespace.db";
- my %hash;
- 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.
- }
+ my $resource_file = $domain_dir."/$namespace";
+ return &_do_hash_tie($resource_file,$namespace,$how,$loghead,$logtail);
}
sub untie_domain_hash {
- my ($hashref) = @_;
- untie(%$hashref);
+ return &_do_hash_untie(@_);
}
#
# Ties a user's resource file to a hash.
@@ -1017,18 +1003,27 @@
$namespace=~s/\//\_/g; # / -> _
$namespace=~s/\W//g; # whitespace eliminated.
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;
- if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",
- $how, 0640)) {
+ if(tie(%hash, 'GDBM_File', "$file_prefix.db", $how, 0640)) {
# If this is a namespace for which a history is kept,
# make the history log entry:
if (($namespace !~/^nohist\_/) && (defined($loghead))) {
my $args = scalar @_;
- Debug(" Opening history: $namespace $args");
- my $hfh = IO::File->new(">>$proname/$namespace.hist");
+ Debug(" Opening history: $file_prefix $args");
+ my $hfh = IO::File->new(">>$file_prefix.hist");
if($hfh) {
my $now = time;
print $hfh "$loghead:$now:$what\n";
@@ -1039,10 +1034,9 @@
} else {
return undef;
}
-
}
-sub untie_user_hash {
+sub _do_hash_untie {
my ($hashref) = @_;
my $result = untie(%$hashref);
return $result;