[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.899 and 1.904

version 1.899, 2007/07/26 02:09:24 version 1.904, 2007/08/08 22:24:34
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);
         unless ($response eq '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 906  sub usersearch { Line 918  sub usersearch {
             if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {              if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
                 &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);                  &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);
             } else {              } else {
                 my @matches = split/&/,$reply;                  my @matches = split(/&/,$reply);
                 foreach my $match (@matches) {                  foreach my $match (@matches) {
                     my @items = split(/:/,$match);                      my @items = split(/:/,$match);
                     my ($uname,$udom,%userhash);                      my ($uname,$udom,%userhash);
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));
Removed from v.1.899  
changed lines
  Added in v.1.904

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