[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.908 and 1.910.2.2

version 1.908, 2007/08/29 22:19:24 version 1.910.2.2, 2007/09/29 04:06:34
Line 582  sub compare_server_load { Line 582  sub compare_server_load {
     }      }
     return ($spare_server,$lowest_load);      return ($spare_server,$lowest_load);
 }  }
   
   # --------------------------- ask offload servers if user already has a session
   sub find_existing_session {
       my ($udom,$uname) = @_;
       foreach my $try_server (@{ $spareid{'primary'} },
       @{ $spareid{'default'} }) {
    return $try_server if (&has_user_session($try_server, $udom, $uname));
       }
       return;
   }
   
   # -------------------------------- ask if server already has a session for user
   sub has_user_session {
       my ($lonid,$udom,$uname) = @_;
       my $result = &reply(join(':','userhassession',
        map {&escape($_)} ($udom,$uname)),$lonid);
       return 1 if ($result eq 'ok');
   
       return 0;
   }
   
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
   
 sub changepass {  sub changepass {
Line 861  sub inst_directory_query { Line 882  sub inst_directory_query {
     my $udom = $srch->{'srchdomain'};      my $udom = $srch->{'srchdomain'};
     my %results;      my %results;
     my $homeserver = &domain($udom,'primary');      my $homeserver = &domain($udom,'primary');
       my $outcome;
     if ($homeserver ne '') {      if ($homeserver ne '') {
  my $queryid=&reply("querysend:instdirsearch:".   my $queryid=&reply("querysend:instdirsearch:".
    &escape($srch->{'srchby'}).':'.     &escape($srch->{'srchby'}).':'.
Line 880  sub inst_directory_query { Line 902  sub inst_directory_query {
  }   }
   
         if (!&error($response) && $response ne 'refused') {          if (!&error($response) && $response ne 'refused') {
             my @matches = split(/\n/,$response);              if ($response eq 'unavailable') {
             foreach my $match (@matches) {                  $outcome = $response;
                 my ($key,$value) = split(/=/,$match);              } else {
                 $results{&unescape($key).':'.$udom} = &thaw_unescape($value);                  $outcome = 'ok';
                   my @matches = split(/\n/,$response);
                   foreach my $match (@matches) {
                       my ($key,$value) = split(/=/,$match);
                       $results{&unescape($key).':'.$udom} = &thaw_unescape($value);
                   }
             }              }
         }          }
     }      }
     return %results;      return ($outcome,%results);
 }  }
   
 sub usersearch {  sub usersearch {
Line 1217  sub do_cache_new { Line 1244  sub do_cache_new {
  $time=600;   $time=600;
     }      }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }      if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
     if (!($memcache->set($id,$setvalue,$time))) {      my $result = $memcache->set($id,$setvalue,$time);
       if (! $result) {
  &logthis("caching of id -> $id  failed");   &logthis("caching of id -> $id  failed");
    $memcache->disconnect_all();
     }      }
     # need to make a copy of $value      # need to make a copy of $value
     #&make_room($id,$value,$debug);      #&make_room($id,$value,$debug);
Line 7727  sub hreflocation { Line 7756  sub hreflocation {
  $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/   $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
     -/uploaded/$1/$2/-x;      -/uploaded/$1/$2/-x;
     }      }
       if ($file=~ m{^/userfiles/}) {
    $file =~ s{^/userfiles/}{/uploaded/};
       }
     return $file;      return $file;
 }  }
   
Removed from v.1.908  
changed lines
  Added in v.1.910.2.2

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