--- loncom/lond 2004/07/23 13:36:29 1.208 +++ loncom/lond 2004/07/23 14:10:47 1.209 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.208 2004/07/23 13:36:29 albertel Exp $ +# $Id: lond,v 1.209 2004/07/23 14:10:47 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -56,7 +56,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.208 $'; #' stupid emacs +my $VERSION='$Revision: 1.209 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -955,7 +955,7 @@ sub EditFile { # Reference to a hash bound to the db file or alternatively undef # if the tie failed. # -sub TieDomainHash { +sub tie_domain_hash { my ($domain, $namespace, $how) = @_; @@ -1016,29 +1016,26 @@ sub TieUserHash { $namespace=~s/\W//g; # whitespace eliminated. my $proname = propath($domain, $user); - # If this is a namespace for which a history is kept, - # make the history log entry: - - - if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) { - my $args = scalar @_; - Debug(" Opening history: $namespace $args"); - my $hfh = IO::File->new(">>$proname/$namespace.hist"); - if($hfh) { - my $now = time; - my $loghead = shift; - my $what = shift; - print $hfh "$loghead:$now:$what\n"; - } - } # Tie the database. my %hash; if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", $how, 0640)) { + # If this is a namespace for which a history is kept, + # make the history log entry: + if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) { + my $args = scalar @_; + Debug(" Opening history: $namespace $args"); + my $hfh = IO::File->new(">>$proname/$namespace.hist"); + if($hfh) { + my $now = time; + my $loghead = shift; + my $what = shift; + print $hfh "$loghead:$now:$what\n"; + } + } return \%hash; - } - else { + } else { return undef; } @@ -2495,17 +2492,16 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File', "$proname/$namespace.db", &GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; } + } + foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); $hash{$key}=$value; @@ -2540,17 +2536,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File', "$proname/$namespace.db", &GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; } + } foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); # We could check that we have a number... @@ -2592,17 +2586,16 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { - print $hfh "P:$now:$exedom:$exeuser:$what\n"; - } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { + print $hfh "P:$now:$exedom:$exeuser:$what\n"; + } + } + foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); &ManagePermissions($key, $udom, $uname, @@ -2643,17 +2636,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { - print $hfh "D:$now:$exedom:$exeuser:$what\n"; - } - } my @rolekeys=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { + print $hfh "D:$now:$exedom:$exeuser:$what\n"; + } + } foreach my $key (@rolekeys) { delete $hash{$key}; } @@ -2770,15 +2761,13 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "D:$now:$what\n"; } - } my @keys=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "D:$now:$what\n"; } + } foreach my $key (@keys) { delete($hash{$key}); } @@ -2933,15 +2922,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "P:$now:$rid:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { + print $hfh "P:$now:$rid:$what\n"; + } + } my @previouskeys=split(/&/,$hash{"keys:$rid"}); my $key; $hash{"version:$rid"}++; @@ -3167,15 +3156,15 @@ sub make_new_child { $udom=~s/\W//g; my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { + { + my $hfh; + if ($hfh=IO::File->new(">>$proname.hist")) { + print $hfh "P:$now:$what\n"; + } + } foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); $hash{$key}=$value;