[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.232 and 1.235

version 1.232, 2002/05/23 20:37:25 version 1.235, 2002/05/29 14:10:28
Line 140  sub reply { Line 140  sub reply {
     unless (defined($hostname{$server})) { return 'no_such_host'; }      unless (defined($hostname{$server})) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);      my $answer=subreply($cmd,$server);
     if ($answer eq 'con_lost') {      if ($answer eq 'con_lost') {
        sleep 5;          #sleep 5; 
        $answer=subreply($cmd,$server);         #$answer=subreply($cmd,$server);
        if ($answer eq 'con_lost') {         #if ($answer eq 'con_lost') {
    &logthis("Second attempt con_lost on $server");   #   &logthis("Second attempt con_lost on $server");
            my $peerfile="$perlvar{'lonSockDir'}/$server";          #   my $peerfile="$perlvar{'lonSockDir'}/$server";
            my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",          #   my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                             Type    => SOCK_STREAM,          #                                    Type    => SOCK_STREAM,
                                             Timeout => 10)          #                                    Timeout => 10)
                       or return "con_lost";          #              or return "con_lost";
            &logthis("Killing socket");          #   &logthis("Killing socket");
            print $client "close_connection_exit\n";          #   print $client "close_connection_exit\n";
            sleep 5;             #sleep 5;
            $answer=subreply($cmd,$server);                 #   $answer=subreply($cmd,$server);       
        }            #}   
     }      }
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {      if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=blue>WARNING:".         &logthis("<font color=blue>WARNING:".
Line 799  sub checkout { Line 799  sub checkout {
     my $now=time;      my $now=time;
     my $lonhost=$perlvar{'lonHostID'};      my $lonhost=$perlvar{'lonHostID'};
     my $infostr=&escape(      my $infostr=&escape(
                    'CHECKOUTTOKEN&'.
                  $tuname.'&'.                   $tuname.'&'.
                  $tudom.'&'.                   $tudom.'&'.
                  $tcrsid.'&'.                   $tcrsid.'&'.
Line 848  sub checkin { Line 849  sub checkin {
     $lonhost=~tr/A-Z/a-z/;      $lonhost=~tr/A-Z/a-z/;
     my $dtoken=$ta.'_'.$hostip{$lonhost}.'_'.$tb;      my $dtoken=$ta.'_'.$hostip{$lonhost}.'_'.$tb;
     $dtoken=~s/\W/\_/g;      $dtoken=~s/\W/\_/g;
     my ($tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=      my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));                   split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
   
     unless (($tuname) && ($tudom)) {      unless (($tuname) && ($tudom)) {
Line 1736  sub is_on_map { Line 1737  sub is_on_map {
     $pathname=~s/\/$filename$//;      $pathname=~s/\/$filename$//;
     my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~      my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
        /\&$filename\:([\d\|]+)\&/);         /\&$filename\:([\d\|]+)\&/);
     &logthis('is: '.$uri.' '.$match.' '.$1);  
     if ($match) {      if ($match) {
        return (1,$1);         return (1,$1);
    } else {     } else {
Line 2787  sub declutter { Line 2787  sub declutter {
     $thisfn=~s/^$perlvar{'lonDocRoot'}//;      $thisfn=~s/^$perlvar{'lonDocRoot'}//;
     $thisfn=~s/^\///;      $thisfn=~s/^\///;
     $thisfn=~s/^res\///;      $thisfn=~s/^res\///;
       $thisfn=~s/\?.+$//;
     return $thisfn;      return $thisfn;
 }  }
   
Removed from v.1.232  
changed lines
  Added in v.1.235

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