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

version 1.904, 2007/08/08 22:24:34 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 6317  sub EXT { Line 6346  sub EXT {
     my ($map) = &decode_symb($symbparm);      my ($map) = &decode_symb($symbparm);
     return &symbread($map);      return &symbread($map);
  }   }
    if ($space eq 'filename') {
       if ($symbparm) {
    return &clutter((&decode_symb($symbparm))[2]);
       }
       return &hreflocation('',$env{'request.filename'});
    }
   
  my ($section, $group, @groups);   my ($section, $group, @groups);
  my ($courselevelm,$courselevel);   my ($courselevelm,$courselevel);
Line 6690  sub metadata { Line 6725  sub metadata {
  # only ws inside the tag, and not in default, so use default   # only ws inside the tag, and not in default, so use default
  # as value   # as value
     $metaentry{':'.$unikey}=$default;      $metaentry{':'.$unikey}=$default;
  } else {   } elsif ( $internaltext =~ /\S/ ) {
   # either something interesting inside the tag or default    # something interesting inside the tag
                   # uninteresting  
     $metaentry{':'.$unikey}=$internaltext;      $metaentry{':'.$unikey}=$internaltext;
    } else {
     # no interesting values, don't set a default
  }   }
 # end of not-a-package not-a-library import  # end of not-a-package not-a-library import
     }      }
Line 6833  sub gettitle { Line 6869  sub gettitle {
  }   }
  my ($map,$resid,$url)=&decode_symb($symb);   my ($map,$resid,$url)=&decode_symb($symb);
  my $title='';   my $title='';
  my %bighash;   if (!$map && $resid == 0 && $url =~/default\.sequence$/) {
  if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',      $title = $env{'course.'.$env{'request.course.id'}.'.description'};
  &GDBM_READER(),0640)) {   } else {
     my $mapid=$bighash{'map_pc_'.&clutter($map)};      if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
     $title=$bighash{'title_'.$mapid.'.'.$resid};      &GDBM_READER(),0640)) {
     untie %bighash;   my $mapid=$bighash{'map_pc_'.&clutter($map)};
    $title=$bighash{'title_'.$mapid.'.'.$resid};
    untie(%bighash);
       }
  }   }
  $title=~s/\&colon\;/\:/gs;   $title=~s/\&colon\;/\:/gs;
  if ($title) {   if ($title) {
Line 7717  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;
 }  }
   
Line 8562  explanation of a user role term Line 8604  explanation of a user role term
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :  get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
 All arguments are optional. Returns a hash of a roles, either for  All arguments are optional. Returns a hash of a roles, either for
 co-author/assistant author roles for a user's Construction Space  co-author/assistant author roles for a user's Construction Space
 (default), or if $context is 'user', roles for the user himself,  (default), or if $context is 'userroles', roles for the user himself,
 In the hash, keys are set to colon-sparated $uname,$udom,and $role,  In the hash, keys are set to colon-sparated $uname,$udom,and $role,
 and value is set to colon-separated start and end times for the role.  and value is set to colon-separated start and end times for the role.
 If no username and domain are specified, will default to current  If no username and domain are specified, will default to current
Removed from v.1.904  
changed lines
  Added in v.1.910.2.2

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