[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.86 and 1.90.2.1

version 1.86, 2002/08/08 13:45:21 version 1.90.2.1, 2002/09/03 02:02:50
Line 497  sub make_new_child { Line 497  sub make_new_child {
 # =============================================================================  # =============================================================================
             # do something with the connection              # do something with the connection
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
       $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of
                                         # connection liveness.
             # see if we know client and check for spoof IP by challenge              # see if we know client and check for spoof IP by challenge
             my $caller=getpeername($client);              my $caller=getpeername($client);
             my ($port,$iaddr)=unpack_sockaddr_in($caller);              my ($port,$iaddr)=unpack_sockaddr_in($caller);
Line 952  sub make_new_child { Line 954  sub make_new_child {
                       my ($cmd,$fname)=split(/:/,$userinput);                        my ($cmd,$fname)=split(/:/,$userinput);
       my ($udom,$uname,$ufile)=split(/\//,$fname);        my ($udom,$uname,$ufile)=split(/\//,$fname);
                       my $udir=propath($udom,$uname).'/userfiles';                        my $udir=propath($udom,$uname).'/userfiles';
                       unless (-e $udir) { mkdir($udir); }                        unless (-e $udir) { mkdir($udir,0770); }
                        if (-e $udir) {                         if (-e $udir) {
                        $ufile=~s/^[\.\~]+//;                         $ufile=~s/^[\.\~]+//;
                        $ufile=~s/\///g;                         $ufile=~s/\///g;
Line 1214  sub make_new_child { Line 1216  sub make_new_child {
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
                              study($regexp);
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                if (eval('$key=~/$regexp/')) {                                 my $unescapeKey = &unescape($key);
                                  if (eval('$unescapeKey=~/$regexp/')) {
                                   $qresult.="$key=$hash{$key}&";                                    $qresult.="$key=$hash{$key}&";
        }                                }
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
Line 1570  sub addline { Line 1574  sub addline {
   
 sub getchat {  sub getchat {
     my ($cdom,$cname)=@_;      my ($cdom,$cname)=@_;
     my @entries;      my %hash;
     if (open(CHATIN,&propath($cdom,$cname).'/chatroom.txt')) {      my $proname=&propath($cdom,$cname);
  while ($line=<CHATIN>) { push(@entries,$line); }      my @entries=();
         close(CHATIN);      if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
         return @entries;      &GDBM_READER(),0640)) {
    @entries=map { $_.':'.$hash{$_} } sort keys %hash;
    untie %hash;
     }      }
     return ();      return @entries;
 }  }
   
 sub chatadd {  sub chatadd {
     my ($cdom,$cname,$newchat)=@_;      my ($cdom,$cname,$newchat)=@_;
     my @entries=&getchat($cdom,$cname);      my %hash;
     my $time=time;      my $proname=&propath($cdom,$cname);
     my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);      my @entries=();
     my ($thentime,$idnum)=split(/\_/,$lastid);      if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
     my $newid=$time.'_000000';      &GDBM_WRCREAT(),0640)) {
     if ($thentime==$time) {   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
  $idnum=~s/^0+//;   my $time=time;
         $idnum++;   my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
         $idnum=substr('000000'.$idnum,-6,6);   my ($thentime,$idnum)=split(/\_/,$lastid);
         $newid=$time.'_'.$idnum;   my $newid=$time.'_000000';
     }   if ($thentime==$time) {
     push (@entries,$newid.':'.$newchat."\n");      $idnum=~s/^0+//;
     my $expired=$time-3600;      $idnum++;
     open(CHATOUT,'>'.&propath($cdom,$cname).'/chatroom.txt');      $idnum=substr('000000'.$idnum,-6,6);
     foreach (@entries) {      $newid=$time.'_'.$idnum;
         my ($thistime)=($_=~/(\d+)\_/);   }
         if ($thistime>$expired) {   $hash{$newid}=$newchat;
     print CHATOUT $_;   my $expired=$time-3600;
         }   foreach (keys %hash) {
       my ($thistime)=($_=~/(\d+)\_/);
       if ($thistime<$expired) {
    delete $hash{$_};
       }
    }
    untie %hash;
     }      }
     close(CHATOUT);  
 }  }
   
 sub unsub {  sub unsub {
Removed from v.1.86  
changed lines
  Added in v.1.90.2.1

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>