[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.203 and 1.207

version 1.203, 2002/02/25 14:33:58 version 1.207, 2002/04/04 20:37:05
Line 137  sub subreply { Line 137  sub subreply {
   
 sub reply {  sub reply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
       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; 
Line 715  sub flushcourselogs { Line 716  sub flushcourselogs {
     &logthis('Flushing course log buffers');      &logthis('Flushing course log buffers');
     foreach (keys %courselogs) {      foreach (keys %courselogs) {
         my $crsid=$_;          my $crsid=$_;
    &logthis(":$crsid:$coursehombuf{$crsid}");
         if (&reply('log:'.$coursedombuf{$crsid}.':'.          if (&reply('log:'.$coursedombuf{$crsid}.':'.
           &escape($courselogs{$crsid}),            &escape($courselogs{$crsid}),
           $coursehombuf{$crsid}) eq 'ok') {            $coursehombuf{$crsid}) eq 'ok') {
Line 912  sub devalidate { Line 914  sub devalidate {
     }      }
 }  }
   
   sub arrayref2str {
     my ($arrayref) = @_;
     my $result='_ARRAY_REF__';
     foreach my $elem (@$arrayref) {
       if (ref($elem) eq 'ARRAY') {
         $result.=&escape(&arrayref2str($elem)).'&';
       } elsif (ref($elem) eq 'HASH') {
         $result.=&escape(&hashref2str($elem)).'&';
       } elsif (ref($elem)) {
         &logthis("Got a ref of ".(ref($elem))." skipping.");
       } else {
         $result.=&escape($elem).'&';
       }
     }
     $result=~s/\&$//;
     return $result;
   }
   
 sub hash2str {  sub hash2str {
   my (%hash)=@_;    my (%hash) = @_;
   my $result='';    my $result=&hashref2str(\%hash);
   foreach (keys %hash) { $result.=escape($_).'='.escape($hash{$_}).'&'; }    $result=~s/^_HASH_REF__//;
     return $result;
   }
   
   sub hashref2str {
     my ($hashref)=@_;
     my $result='_HASH_REF__';
     foreach (keys(%$hashref)) {
       if (ref($_) eq 'ARRAY') {
         $result.=&escape(&arrayref2str($_)).'=';
       } elsif (ref($_) eq 'HASH') {
         $result.=&escape(&hashref2str($_)).'=';
       } elsif (ref($_)) {
         &logthis("Got a ref of ".(ref($_))." skipping.");
       } else {
         $result.=&escape($_).'=';
       }
   
       if (ref($$hashref{$_}) eq 'ARRAY') {
         $result.=&escape(&arrayref2str($$hashref{$_})).'&';
       } elsif (ref($$hashref{$_}) eq 'HASH') {
         $result.=&escape(&hashref2str($$hashref{$_})).'&';
       } elsif (ref($$hashref{$_})) {
         &logthis("Got a ref of ".(ref($$hashref{$_}))." skipping.");
       } else {
         $result.=&escape($$hashref{$_}).'&';
       }
     }
   $result=~s/\&$//;    $result=~s/\&$//;
   return $result;    return $result;
 }  }
Line 925  sub str2hash { Line 972  sub str2hash {
   my %returnhash;    my %returnhash;
   foreach (split(/\&/,$string)) {    foreach (split(/\&/,$string)) {
     my ($name,$value)=split(/\=/,$_);      my ($name,$value)=split(/\=/,$_);
     $returnhash{&unescape($name)}=&unescape($value);      $name=&unescape($name);
       $value=&unescape($value);
       if ($value =~ /^_HASH_REF__/) {
         $value =~ s/^_HASH_REF__//;
         my %hash=&str2hash($value);
         $value=\%hash;
       } elsif ($value =~ /^_ARRAY_REF__/) {
         $value =~ s/^_ARRAY_REF__//;
         my @array=&str2array($value);
         $value=\@array;
       }
       $returnhash{$name}=$value;
   }    }
   return %returnhash;    return (%returnhash);
   }
   
   sub str2array {
     my ($string) = @_;
     my @returnarray;
     foreach my $value (split(/\&/,$string)) {
       $value=&unescape($value);
       if ($value =~ /^_HASH_REF__/) {
         $value =~ s/^_HASH_REF__//;
         my %hash=&str2hash($value);
         $value=\%hash;
       } elsif ($value =~ /^_ARRAY_REF__/) {
         $value =~ s/^_ARRAY_REF__//;
         my @array=&str2array($value);
         $value=\@array;
       }
       push(@returnarray,$value);
     }
     return (@returnarray);
 }  }
   
 # -------------------------------------------------------------------Temp Store  # -------------------------------------------------------------------Temp Store
Line 1783  sub modifyuserauth { Line 1860  sub modifyuserauth {
   
 # --------------------------------------------------------------- Modify a user  # --------------------------------------------------------------- Modify a user
   
   
 sub modifyuser {  sub modifyuser {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,      my ($udom,    $uname, $uid,
         $forceid)=@_;          $umode,   $upass, $first,
           $middle,  $last,  $gene,
           $forceid, $desiredhome)=@_;
     $udom=~s/\W//g;      $udom=~s/\W//g;
     $uname=~s/\W//g;      $uname=~s/\W//g;
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
      $last.', '.$gene.'(forceid: '.$forceid.') by '.       $last.', '.$gene.'(forceid: '.$forceid.')'.
              $ENV{'user.name'}.' at '.$ENV{'user.domain'});                 (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                        ' desiredhome not specified'). 
                ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && ($umode) && ($upass)) {      if (($uhome eq 'no_host') && ($umode) && ($upass)) {
         my $unhome='';          my $unhome='';
  if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {   if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {
     $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};      $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
           } elsif (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { 
               $unhome = $desiredhome;
         } else {          } else {
             my $tryserver;              my $tryserver;
             my $loadm=10000000;              my $loadm=10000000;
Line 1813  sub modifyuser { Line 1895  sub modifyuser {
     }      }
         }          }
         if (($unhome eq '') || ($unhome eq 'no_host')) {          if (($unhome eq '') || ($unhome eq 'no_host')) {
     return 'error: find home';      return 'error: unable to find a home server for '.$uname.
                      ' in domain '.$udom;
         }          }
         my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'.          my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'.
                          &escape($upass),$unhome);                           &escape($upass),$unhome);
Line 1842  sub modifyuser { Line 1925  sub modifyuser {
     my %names=&get('environment',      my %names=&get('environment',
    ['firstname','middlename','lastname','generation'],     ['firstname','middlename','lastname','generation'],
    $udom,$uname);     $udom,$uname);
       if ($names{'firstname'} =~ m/^error:.*/) { %names=(); }
     if ($first)  { $names{'firstname'}  = $first; }      if ($first)  { $names{'firstname'}  = $first; }
     if ($middle) { $names{'middlename'} = $middle; }      if ($middle) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }      if ($last)   { $names{'lastname'}   = $last; }
Line 2635  sub unescape { Line 2719  sub unescape {
 # ================================================================ Main Program  # ================================================================ Main Program
   
 sub goodbye {  sub goodbye {
      &logthis("Starting Shut down");
    &flushcourselogs();     &flushcourselogs();
    &logthis("Shutting down");     &logthis("Shutting down");
 }  }
Line 2897  devalidate($symb) : devalidate spreadshe Line 2982  devalidate($symb) : devalidate spreadshe
 =item *  =item *
   
 hash2str(%hash) : convert a hash into a string complete with escaping and '='  hash2str(%hash) : convert a hash into a string complete with escaping and '='
 and '&' separators  and '&' separators, supports elements that are arrayrefs and hashrefs
   
   =item *
   
   hashref2str($hashref) : convert a hashref into a string complete with
   escaping and '=' and '&' separators, supports elements that are
   arrayrefs and hashrefs
   
   =item *
   
   arrayref2str($arrayref) : convert an arrayref into a string complete
   with escaping and '&' separators, supports elements that are arrayrefs
   and hashrefs
   
   =item *
   
   str2hash($string) : convert string to hash using unescaping and
   splitting on '=' and '&', supports elements that are arrayrefs and
   hashrefs
   
 =item *  =item *
   
 str2hash($string) : convert string to hash using unescaping and splitting on  str2array($string) : convert string to hash using unescaping and
 '=' and '&'  splitting on '&', supports elements that are arrayrefs and hashrefs
   
 =item *  =item *
   
Removed from v.1.203  
changed lines
  Added in v.1.207

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