--- loncom/lond 2006/05/31 14:46:48 1.305.2.7
+++ loncom/lond 2006/01/27 23:04:27 1.308
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.305.2.7 2006/05/31 14:46:48 albertel Exp $
+# $Id: lond,v 1.308 2006/01/27 23:04:27 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,15 +53,13 @@ use LONCAPA::ConfigFileEdit;
use LONCAPA::lonlocal;
use LONCAPA::lonssl;
use Fcntl qw(:flock);
-use Symbol;
my $DEBUG = 0; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $lond_max_wait_time = 13;
-my $VERSION='$Revision: 1.305.2.7 $'; #' stupid emacs
+my $VERSION='$Revision: 1.308 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -89,6 +87,7 @@ my $ConnectionType;
my %hostid; # ID's for hosts in cluster by ip.
my %hostdom; # LonCAPA domain for hosts in cluster.
+my %hostname; # DNSname -> ID's mapping.
my %hostip; # IPs for hosts in cluster.
my %hostdns; # ID's of hosts looked up by DNS name.
@@ -972,13 +971,23 @@ sub tie_domain_hash {
my $user_top_dir = $perlvar{'lonUsersDir'};
my $domain_dir = $user_top_dir."/$domain";
- my $resource_file = $domain_dir."/$namespace";
- return &_locking_hash_tie($resource_file,$namespace,$how,$loghead,$logtail);
+ 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.
+ }
}
-sub untie_domain_hash {
- return &_locking_hash_untie(@_);
-}
#
# Ties a user's resource file to a hash.
# If necessary, an appropriate history
@@ -1004,27 +1013,18 @@ sub tie_user_hash {
$namespace=~s/\//\_/g; # / -> _
$namespace=~s/\W//g; # whitespace eliminated.
my $proname = propath($domain, $user);
-
- my $file_prefix="$proname/$namespace";
- return &_locking_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
-}
-
-sub untie_user_hash {
- return &_locking_hash_untie(@_);
-}
-
-# internal routines that handle the actual tieing and untieing process
-
-sub _do_hash_tie {
- my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
+
+ # Tie the database.
+
my %hash;
- if(tie(%hash, 'GDBM_File', "$file_prefix.db", $how, 0640)) {
+ 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\_/) && (defined($loghead))) {
my $args = scalar @_;
- Debug(" Opening history: $file_prefix $args");
- my $hfh = IO::File->new(">>$file_prefix.hist");
+ Debug(" Opening history: $namespace $args");
+ my $hfh = IO::File->new(">>$proname/$namespace.hist");
if($hfh) {
my $now = time;
print $hfh "$loghead:$now:$what\n";
@@ -1035,72 +1035,7 @@ sub _do_hash_tie {
} else {
return undef;
}
-}
-
-sub _do_hash_untie {
- my ($hashref) = @_;
- my $result = untie(%$hashref);
- return $result;
-}
-
-{
- my $sym;
-
- sub _locking_hash_tie {
- my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
-
- my ($lock);
- if ($how eq &GDBM_READER()) {
- $lock=LOCK_SH;
- $how=$how|&GDBM_NOLOCK();
- #if the db doesn't exist we can't read from it
- if (! -e "$file_prefix.db") {
- $! = 2;
- return undef;
- }
- } elsif ($how eq &GDBM_WRCREAT()) {
- $lock=LOCK_EX;
- $how=$how|&GDBM_NOLOCK();
- if (! -e "$file_prefix.db") {
- # doesn't exist but we need it to in order to successfully
- # lock it so bring it into existance
- open(TOUCH,">>$file_prefix.db");
- close(TOUCH);
- }
- } else {
- &logthis("Unknown method $how for $file_prefix");
- die();
- }
-
- $sym=&Symbol::gensym();
- open($sym,"$file_prefix.db");
- my $failed=0;
- eval {
- local $SIG{__DIE__}='DEFAULT';
- local $SIG{ALRM}=sub {
- $failed=1;
- die("failed lock");
- };
- alarm($lond_max_wait_time);
- flock($sym,$lock);
- alarm(0);
- };
- if ($failed) {
- $! = 100; # throwing error # 100
- return undef;
- }
- return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
- }
-
- sub _locking_hash_untie {
- my ($hashref) = @_;
- my $result = untie(%$hashref);
- flock($sym,LOCK_UN);
- close($sym);
- undef($sym);
- return $result;
- }
}
# read_profile
@@ -1133,7 +1068,7 @@ sub read_profile {
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string.
}
$qresult=~s/\&$//; # Remove trailing & from last lookup.
- if (&untie_user_hash($hashref)) {
+ if (untie %$hashref) {
return $qresult;
} else {
return "error: ".($!+0)." untie (GDBM) Failed";
@@ -2290,11 +2225,8 @@ sub token_auth_user_file_handler {
my $reply="non_auth\n";
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
$session.'.id')) {
- flock(ENVIN,LOCK_SH);
while (my $line=<ENVIN>) {
- my ($envname)=split(/=/,$line,2);
- $envname=&unescape($envname);
- if ($envname=~ m|^userfile\.\Q$fname\E|) { $reply="ok\n"; }
+ if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply="ok\n"; }
}
close(ENVIN);
&Reply($client, $reply, "$cmd:$tail");
@@ -2445,7 +2377,7 @@ sub put_user_profile_entry {
my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply( $client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2453,7 +2385,7 @@ sub put_user_profile_entry {
$userinput);
}
} else {
- &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+ &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
"while attempting put\n", $userinput);
}
} else {
@@ -2489,7 +2421,7 @@ sub newput_user_profile_entry {
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_WRCREAT(),"N",$what);
if(!$hashref) {
- &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+ &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
"while attempting put\n", $userinput);
return 1;
}
@@ -2508,7 +2440,7 @@ sub newput_user_profile_entry {
$hashref->{$key}=$value;
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply( $client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2561,7 +2493,7 @@ sub increment_user_value_handler {
}
}
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply( $client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2628,7 +2560,7 @@ sub roles_put_handler {
$auth_type);
$hashref->{$key}=$value;
}
- if (&untie_user_hash($hashref)) {
+ if (untie($hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2679,7 +2611,7 @@ sub roles_delete_handler {
foreach my $key (@rolekeys) {
delete $hashref->{$key};
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2820,7 +2752,7 @@ sub delete_profile_entry {
foreach my $key (@keys) {
delete($hashref->{$key});
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2862,7 +2794,7 @@ sub get_profile_keys {
foreach my $key (keys %$hashref) {
$qresult.="$key&";
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -2923,7 +2855,7 @@ sub dump_profile_database {
$data{$symb}->{$param}=$value;
$data{$symb}->{'v.'.$param}=$v;
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
while (my ($symb,$param_hash) = each(%data)) {
while(my ($param,$value) = each (%$param_hash)){
next if ($param =~ /^v\./); # Ignore versions...
@@ -2978,27 +2910,44 @@ sub dump_with_regexp {
my $userinput = "$cmd:$tail";
- my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);
+ my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
if (defined($regexp)) {
$regexp=&unescape($regexp);
} else {
$regexp='.';
}
+ my ($start,$end);
+ if (defined($range)) {
+ if ($range =~/^(\d+)\-(\d+)$/) {
+ ($start,$end) = ($1,$2);
+ } elsif ($range =~/^(\d+)$/) {
+ ($start,$end) = (0,$1);
+ } else {
+ undef($range);
+ }
+ }
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());
if ($hashref) {
my $qresult='';
+ my $count=0;
while (my ($key,$value) = each(%$hashref)) {
if ($regexp eq '.') {
+ $count++;
+ if (defined($range) && $count >= $end) { last; }
+ if (defined($range) && $count < $start) { next; }
$qresult.=$key.'='.$value.'&';
} else {
my $unescapeKey = &unescape($key);
if (eval('$unescapeKey=~/$regexp/')) {
+ $count++;
+ if (defined($range) && $count >= $end) { last; }
+ if (defined($range) && $count < $start) { next; }
$qresult.="$key=$value&";
}
}
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%$hashref)) {
chop($qresult);
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -3060,7 +3009,7 @@ sub store_handler {
$hashref->{"$version:$rid:timestamp"}=$now;
$allkeys.='timestamp';
$hashref->{"$version:keys:$rid"}=$allkeys;
- if (&untie_user_hash($hashref)) {
+ if (untie($hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3112,22 +3061,24 @@ sub restore_handler {
$namespace=~s/\//\_/g;
$namespace=~s/\W//g;
chomp($rid);
+ my $proname=&propath($udom,$uname);
my $qresult='';
- my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
- if ($hashref) {
- my $version=$hashref->{"version:$rid"};
+ my %hash;
+ if (tie(%hash,'GDBM_File',"$proname/$namespace.db",
+ &GDBM_READER(),0640)) {
+ my $version=$hash{"version:$rid"};
$qresult.="version=$version&";
my $scope;
for ($scope=1;$scope<=$version;$scope++) {
- my $vkeys=$hashref->{"$scope:keys:$rid"};
+ my $vkeys=$hash{"$scope:keys:$rid"};
my @keys=split(/:/,$vkeys);
my $key;
$qresult.="$scope:keys=$vkeys&";
foreach $key (@keys) {
- $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
+ $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
}
}
- if (&untie_user_hash($hashref)) {
+ if (untie(%hash)) {
$qresult=~s/\&$//;
&Reply( $client, "$qresult\n", $userinput);
} else {
@@ -3360,7 +3311,7 @@ sub put_course_id_handler {
}
$hashref->{$key}=$courseinfo.':'.$now;
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply( $client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)
@@ -3476,7 +3427,7 @@ sub dump_course_id_handler {
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
}
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
chop($qresult);
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -3525,7 +3476,7 @@ sub put_id_handler {
my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3574,7 +3525,7 @@ sub get_id_handler {
for (my $i=0;$i<=$#queries;$i++) {
$qresult.="$hashref->{$queries[$i]}&";
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -3618,7 +3569,7 @@ sub put_dcmail_handler {
my ($key,$value)=split(/=/,$what);
$hashref->{$key}=$value;
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3698,7 +3649,7 @@ sub dump_dcmail_handler {
$qresult.=$key.'='.$value.'&';
}
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
chop($qresult);
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -3745,7 +3696,7 @@ sub put_domainroles_handler {
my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3826,7 +3777,7 @@ sub dump_domainroles_handler {
$qresult.=$key.'='.$value.'&';
}
}
- if (&untie_domain_hash($hashref)) {
+ if (untie(%$hashref)) {
chop($qresult);
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -4321,83 +4272,6 @@ sub get_institutional_code_format_handle
®ister_handler("autoinstcodeformat",
\&get_institutional_code_format_handler,0,1,0);
-# Get domain specific conditions for import of student photographs to a course
-#
-# Retrieves information from photo_permission subroutine in localenroll.
-# Returns outcome (ok) if no processing errors, and whether course owner is
-# required to accept conditions of use (yes/no).
-#
-#
-sub photo_permission_handler {
- my ($cmd, $tail, $client) = @_;
- my $userinput = "$cmd:$tail";
- my $cdom = $tail;
- my ($perm_reqd,$conditions);
- my $outcome;
- eval {
- local($SIG{__DIE__})='DEFAULT';
- $outcome = &localenroll::photo_permission($cdom,\$perm_reqd,
- \$conditions);
- };
- if (!$@) {
- &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n",
- $userinput);
- } else {
- &Failure($client,"unknown_cmd\n",$userinput);
- }
- return 1;
-}
-®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0);
-
-#
-# Checks if student photo is available for a user in the domain, in the user's
-# directory (in /userfiles/internal/studentphoto.jpg).
-# Uses localstudentphoto:fetch() to ensure there is an up to date copy of
-# the student's photo.
-
-sub photo_check_handler {
- my ($cmd, $tail, $client) = @_;
- my $userinput = "$cmd:$tail";
- my ($udom,$uname,$pid) = split(/:/,$tail);
- $udom = &unescape($udom);
- $uname = &unescape($uname);
- $pid = &unescape($pid);
- my $path=&propath($udom,$uname).'/userfiles/internal/';
- if (!-e $path) {
- &mkpath($path);
- }
- my $response;
- my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response);
- $result .= ':'.$response;
- &Reply($client, &escape($result)."\n",$userinput);
- return 1;
-}
-®ister_handler("autophotocheck",\&photo_check_handler,0,1,0);
-
-#
-# Retrieve information from localenroll about whether to provide a button
-# for users who have enbled import of student photos to initiate an
-# update of photo files for registered students. Also include
-# comment to display alongside button.
-
-sub photo_choice_handler {
- my ($cmd, $tail, $client) = @_;
- my $userinput = "$cmd:$tail";
- my $cdom = &unescape($tail);
- my ($update,$comment);
- eval {
- local($SIG{__DIE__})='DEFAULT';
- ($update,$comment) = &localenroll::manager_photo_update($cdom);
- };
- if (!$@) {
- &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput);
- } else {
- &Failure($client,"unknown_cmd\n",$userinput);
- }
- return 1;
-}
-®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0);
-
#
# Gets a student's photo to exist (in the correct image type) in the user's
# directory.
@@ -4410,36 +4284,24 @@ sub photo_choice_handler {
# $client - The socket open on the client.
# Returns:
# 1 - continue processing.
-
sub student_photo_handler {
my ($cmd, $tail, $client) = @_;
- my ($domain,$uname,$ext,$type) = split(/:/, $tail);
+ my ($domain,$uname,$type) = split(/:/, $tail);
- my $path=&propath($domain,$uname). '/userfiles/internal/';
- my $filename = 'studentphoto.'.$ext;
- if ($type eq 'thumbnail') {
- $filename = 'studentphoto_tn.'.$ext;
- }
- if (-e $path.$filename) {
+ my $path=&propath($domain,$uname).
+ '/userfiles/internal/studentphoto.'.$type;
+ if (-e $path) {
&Reply($client,"ok\n","$cmd:$tail");
return 1;
}
&mkpath($path);
- my $file;
- if ($type eq 'thumbnail') {
- eval {
- local($SIG{__DIE__})='DEFAULT';
- $file=&localstudentphoto::fetch_thumbnail($domain,$uname);
- };
- } else {
- $file=&localstudentphoto::fetch($domain,$uname);
- }
+ my $file=&localstudentphoto::fetch($domain,$uname);
if (!$file) {
&Failure($client,"unavailable\n","$cmd:$tail");
return 1;
}
- if (!-e $path.$filename) { &convert_photo($file,$path.$filename); }
- if (-e $path.$filename) {
+ if (!-e $path) { &convert_photo($file,$path); }
+ if (-e $path) {
&Reply($client,"ok\n","$cmd:$tail");
return 1;
}
@@ -4854,6 +4716,7 @@ sub ReadHostTable {
}
$hostid{$ip}=$id; # LonCAPA name of host by IP.
$hostdom{$id}=$domain; # LonCAPA domain name of host.
+ $hostname{$id}=$name; # LonCAPA name -> DNS name
$hostip{$id}=$ip; # IP address of host.
$hostdns{$name} = $id; # LonCAPA name of host by DNS.
@@ -5104,12 +4967,12 @@ sub reconlonc {
sub subreply {
my ($cmd,$server)=@_;
- my $peerfile="$perlvar{'lonSockDir'}/$server";
+ my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
Type => SOCK_STREAM,
Timeout => 10)
or return "con_lost";
- print $sclient "$cmd\n";
+ print $sclient "sethost:$server:$cmd\n";
my $answer=<$sclient>;
chomp($answer);
if (!$answer) { $answer="con_lost"; }
@@ -5125,7 +4988,7 @@ sub reply {
$answer=subreply("ping",$server);
if ($answer ne $server) {
&logthis("sub reply: answer != server answer is $answer, server is $server");
- &reconlonc("$perlvar{'lonSockDir'}/$server");
+ &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server});
}
$answer=subreply($cmd,$server);
}
@@ -5152,7 +5015,7 @@ sub sub_sql_reply {
Type => SOCK_STREAM,
Timeout => 10)
or return "con_lost";
- print $sclient "$cmd:$currentdomainid\n";
+ print $sclient "$cmd\n";
my $answer=<$sclient>;
chomp($answer);
if (!$answer) { $answer="con_lost"; }
@@ -5431,7 +5294,7 @@ sub make_new_child {
# no need to try to do recon's to myself
next;
}
- &reconlonc("$perlvar{'lonSockDir'}/$id");
+ &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$id});
}
&logthis("<font color='green'>Established connection: $clientname</font>");
&status('Will listen to '.$clientname);
@@ -5762,38 +5625,38 @@ sub addline {
sub get_chat {
my ($cdom,$cname,$udom,$uname)=@_;
-
+ my %hash;
+ my $proname=&propath($cdom,$cname);
my @entries=();
- my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
- &GDBM_READER());
- if ($hashref) {
- @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
- &untie_user_hash($hashref);
+ if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
+ &GDBM_READER(),0640)) {
+ @entries=map { $_.':'.$hash{$_} } sort keys %hash;
+ untie %hash;
}
my @participants=();
my $cutoff=time-60;
- $hashref = &tie_user_hash($cdom, $cname, 'nohist_inchatroom',
- &GDBM_WRCREAT());
- if ($hashref) {
- $hashref->{$uname.':'.$udom}=time;
- foreach my $user (sort(keys(%$hashref))) {
- if ($hashref->{$user}>$cutoff) {
- push(@participants, 'active_participant:'.$user);
+ if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
+ &GDBM_WRCREAT(),0640)) {
+ $hash{$uname.':'.$udom}=time;
+ foreach (sort keys %hash) {
+ if ($hash{$_}>$cutoff) {
+ $participants[$#participants+1]='active_participant:'.$_;
}
}
- &untie_user_hash($hashref);
+ untie %hash;
}
return (@participants,@entries);
}
sub chat_add {
my ($cdom,$cname,$newchat)=@_;
+ my %hash;
+ my $proname=&propath($cdom,$cname);
my @entries=();
my $time=time;
- my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
- &GDBM_WRCREAT());
- if ($hashref) {
- @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
+ if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
+ &GDBM_WRCREAT(),0640)) {
+ @entries=map { $_.':'.$hash{$_} } sort keys %hash;
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
my ($thentime,$idnum)=split(/\_/,$lastid);
my $newid=$time.'_000000';
@@ -5803,22 +5666,21 @@ sub chat_add {
$idnum=substr('000000'.$idnum,-6,6);
$newid=$time.'_'.$idnum;
}
- $hashref->{$newid}=$newchat;
+ $hash{$newid}=$newchat;
my $expired=$time-3600;
- foreach my $comment (keys(%$hashref)) {
- my ($thistime) = ($comment=~/(\d+)\_/);
+ foreach (keys %hash) {
+ my ($thistime)=($_=~/(\d+)\_/);
if ($thistime<$expired) {
- delete $hashref->{$comment};
+ delete $hash{$_};
}
}
- {
- my $proname=&propath($cdom,$cname);
- if (open(CHATLOG,">>$proname/chatroom.log")) {
- print CHATLOG ("$time:".&unescape($newchat)."\n");
- }
- close(CHATLOG);
+ untie %hash;
+ }
+ {
+ my $hfh;
+ if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
+ print $hfh "$time:".&unescape($newchat)."\n";
}
- &untie_user_hash($hashref);
}
}