[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.900 and 1.906

version 1.900, 2007/07/26 04:05:43 version 1.906, 2007/08/10 23:02:36
Line 862  sub inst_directory_query { Line 862  sub inst_directory_query {
     my %results;      my %results;
     my $homeserver = &domain($udom,'primary');      my $homeserver = &domain($udom,'primary');
     if ($homeserver ne '') {      if ($homeserver ne '') {
         my $response=&reply("instdirsrch:$udom".':'.   my $queryid=&reply("querysend:instdirsearch:".
                             &escape($srch->{'srchby'}).':'.     &escape($srch->{'srchby'}).':'.
                             &escape($srch->{'srchterm'}).':'.     &escape($srch->{'srchterm'}).':'.
                             $srch->{'srchtype'},$homeserver);     &escape($srch->{'srchtype'}),$homeserver);
         if ($response ne 'refused') {   my $host=&hostname($homeserver);
             my @matches = split/&/,$response;   if ($queryid !~/^\Q$host\E\_/) {
       &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
       return;
    }
    my $response = &get_query_reply($queryid);
    my $maxtries = 5;
    my $tries = 1;
    while (($response=~/^timeout/) && ($tries < $maxtries)) {
       $response = &get_query_reply($queryid);
       $tries ++;
    }
   
           if (!&error($response) && $response ne 'refused') {
               my @matches = split(/\n/,$response);
             foreach my $match (@matches) {              foreach my $match (@matches) {
                 my ($key,$value) = split(/=/,$match);                  my ($key,$value) = split(/=/,$match);
                 my %userhash = &str2hash(&unescape($value));                  $results{&unescape($key).':'.$udom} = &thaw_unescape($value);
                 $results{&unescape($key).':'.$udom} = \%userhash;  
             }              }
         }          }
     }      }
Line 894  sub usersearch { Line 906  sub usersearch {
                        &escape($srch->{'srchterm'}),$tryserver);                         &escape($srch->{'srchterm'}),$tryserver);
             if ($queryid !~/^\Q$host\E\_/) {              if ($queryid !~/^\Q$host\E\_/) {
                 &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver);                  &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver);
                 return 'error: '.$queryid;                  next;
             }              }
             my $reply = &get_query_reply($queryid);              my $reply = &get_query_reply($queryid);
             my $maxtries = 1;              my $maxtries = 1;
Line 2081  sub flushcourselogs { Line 2093  sub flushcourselogs {
 #  #
     my %domrolebuffer = ();      my %domrolebuffer = ();
     foreach my $entry (keys %domainrolehash) {      foreach my $entry (keys %domainrolehash) {
         my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;          my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
         if ($domrolebuffer{$rudom}) {          if ($domrolebuffer{$rudom}) {
             $domrolebuffer{$rudom}.='&'.&escape($entry).              $domrolebuffer{$rudom}.='&'.&escape($entry).
                       '='.&escape($domainrolehash{$entry});                        '='.&escape($domainrolehash{$entry});
Line 2203  sub userrolelog { Line 2215  sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     = $tend.':'.$tstart;                      = $tend.':'.$tstart;
     }      }
     &flushcourselogs();  
 }  }
   
 sub get_course_adv_roles {  sub get_course_adv_roles {
Line 4499  sub fetch_enrollment_query { Line 4510  sub fetch_enrollment_query {
     if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {      if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
         &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);          &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
     } else {      } else {
         my @responses = split/:/,$reply;          my @responses = split(/:/,$reply);
         if ($homeserver eq $perlvar{'lonHostID'}) {          if ($homeserver eq $perlvar{'lonHostID'}) {
             foreach my $line (@responses) {              foreach my $line (@responses) {
                 my ($key,$value) = split(/=/,$line,2);                  my ($key,$value) = split(/=/,$line,2);
Line 4542  sub get_query_reply { Line 4553  sub get_query_reply {
  sleep 2;   sleep 2;
         if (-e $replyfile.'.end') {          if (-e $replyfile.'.end') {
     if (open(my $fh,$replyfile)) {      if (open(my $fh,$replyfile)) {
                $reply.=<$fh>;   $reply = join('',<$fh>);
                close($fh);   close($fh);
    } else { return 'error: reply_file_error'; }     } else { return 'error: reply_file_error'; }
            return &unescape($reply);             return &unescape($reply);
  }   }
Line 4609  sub auto_get_sections { Line 4620  sub auto_get_sections {
     my @secs = ();      my @secs = ();
     my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));      my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
     unless ($response eq 'refused') {      unless ($response eq 'refused') {
         @secs = split/:/,$response;          @secs = split(/:/,$response);
     }      }
     return @secs;      return @secs;
 }  }
Line 4648  sub auto_create_password { Line 4659  sub auto_create_password {
         if ($response eq 'refused') {          if ($response eq 'refused') {
             $authchk = 'refused';              $authchk = 'refused';
         } else {          } else {
             ($authparam,$create_passwd,$authchk) = split/:/,$response;              ($authparam,$create_passwd,$authchk) = split(/:/,$response);
         }          }
     }      }
     return ($authparam,$create_passwd,$authchk);      return ($authparam,$create_passwd,$authchk);
Line 4756  sub auto_instcode_format { Line 4767  sub auto_instcode_format {
         $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);          $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);
         if ($response !~ /(con_lost|error|no_such_host|refused)/) {          if ($response !~ /(con_lost|error|no_such_host|refused)/) {
             my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) =               my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = 
  split/:/,$response;   split(/:/,$response);
             %{$codes} = (%{$codes},&str2hash($codes_str));              %{$codes} = (%{$codes},&str2hash($codes_str));
             push(@{$codetitles},&str2array($codetitles_str));              push(@{$codetitles},&str2array($codetitles_str));
             %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));              %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));
Line 6306  sub EXT { Line 6317  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 8551  explanation of a user role term Line 8568  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.900  
changed lines
  Added in v.1.906

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