[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.1056.2.2 and 1.1060

version 1.1056.2.2, 2010/03/26 21:27:41 version 1.1060, 2010/03/26 00:47:25
Line 3207  sub get_domain_roles { Line 3207  sub get_domain_roles {
     return %personnel;      return %personnel;
 }  }
   
 # ----------------------------------------------------------- Check out an item  # ----------------------------------------------------------- Interval timing 
   
 sub get_first_access {  sub get_first_access {
     my ($type,$argsymb)=@_;      my ($type,$argsymb)=@_;
Line 3243  sub set_first_access { Line 3243  sub set_first_access {
     return 'already_set';      return 'already_set';
 }  }
   
 sub checkout {  
     my ($symb,$tuname,$tudom,$tcrsid)=@_;  
     my $now=time;  
     my $lonhost=$perlvar{'lonHostID'};  
     my $infostr=&escape(  
                  'CHECKOUTTOKEN&'.  
                  $tuname.'&'.  
                  $tudom.'&'.  
                  $tcrsid.'&'.  
                  $symb.'&'.  
  $now.'&'.$ENV{'REMOTE_ADDR'});  
     my $token=&reply('tmpput:'.$infostr,$lonhost);  
     if ($token=~/^error\:/) {   
         &logthis("<font color=\"blue\">WARNING: ".  
                 "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.  
                  "</font>");  
         return '';   
     }  
   
     $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;  
     $token=~tr/a-z/A-Z/;  
   
     my %infohash=('resource.0.outtoken' => $token,  
                   'resource.0.checkouttime' => $now,  
                   'resource.0.outremote' => $ENV{'REMOTE_ADDR'});  
   
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {  
        return '';  
     } else {  
         &logthis("<font color=\"blue\">WARNING: ".  
                 "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.  
                  "</font>");  
     }      
   
     if (&log($tudom,$tuname,&homeserver($tuname,$tudom),  
                          &escape('Checkout '.$infostr.' - '.  
                                                  $token)) ne 'ok') {  
  return '';  
     } else {  
         &logthis("<font color=\"blue\">WARNING: ".  
                 "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.  
                  "</font>");  
     }  
     return $token;  
 }  
   
 # ------------------------------------------------------------ Check in an item  
   
 sub checkin {  
     my $token=shift;  
     my $now=time;  
     my ($ta,$tb,$lonhost)=split(/\*/,$token);  
     $lonhost=~tr/A-Z/a-z/;  
     my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;  
     $dtoken=~s/\W/\_/g;  
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=  
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));  
   
     unless (($tuname) && ($tudom)) {  
         &logthis('Check in '.$token.' ('.$dtoken.') failed');  
         return '';  
     }  
       
     unless (&allowed('mgr',$tcrsid)) {  
         &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.  
                  $env{'user.name'}.' - '.$env{'user.domain'});  
         return '';  
     }  
   
     my %infohash=('resource.0.intoken' => $token,  
                   'resource.0.checkintime' => $now,  
                   'resource.0.inremote' => $ENV{'REMOTE_ADDR'});  
   
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {  
        return '';  
     }      
   
     if (&log($tudom,$tuname,&homeserver($tuname,$tudom),  
                          &escape('Checkin - '.$token)) ne 'ok') {  
  return '';  
     }  
   
     return ($symb,$tuname,$tudom,$tcrsid);      
 }  
   
 # --------------------------------------------- Set Expire Date for Spreadsheet  # --------------------------------------------- Set Expire Date for Spreadsheet
   
 sub expirespread {  sub expirespread {
Line 6602  sub modifyuser { Line 6517  sub modifyuser {
 #  #
 # If name, email and/or uid are blank (e.g., because an uploaded file  # If name, email and/or uid are blank (e.g., because an uploaded file
 # of users did not contain them), do not overwrite existing values  # of users did not contain them), do not overwrite existing values
 # unless field is in $candelete array ref.  # unless field is in $candelete array ref.  
 #  #
   
     my @fields = ('firstname','middlename','lastname','generation',      my @fields = ('firstname','middlename','lastname','generation',
                   'permanentemail','id');                    'permanentemail','id');
     my %newvalues;      my %newvalues;
Line 6616  sub modifyuser { Line 6532  sub modifyuser {
                     $names{$field} = $middle;                      $names{$field} = $middle;
                 } elsif ($field eq 'lastname') {                  } elsif ($field eq 'lastname') {
                     $names{$field} = $last;                      $names{$field} = $last;
                 } elsif ($field eq 'generation') {                  } elsif ($field eq 'generation') { 
                     $names{$field} = $gene;                      $names{$field} = $gene;
                 } elsif ($field eq 'permanentemail') {                  } elsif ($field eq 'permanentemail') {
                     $names{$field} = $email;                      $names{$field} = $email;
Line 6626  sub modifyuser { Line 6542  sub modifyuser {
             }              }
         }          }
     }      }
   
     if ($first)  { $names{'firstname'}  = $first; }      if ($first)  { $names{'firstname'}  = $first; }
     if (defined($middle)) { $names{'middlename'} = $middle; }      if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }      if ($last)   { $names{'lastname'}   = $last; }
Line 10359  modifyuser($udom,$uname,$uid,$umode,$upa Line 10274  modifyuser($udom,$uname,$uid,$umode,$upa
 will update user information (firstname,middlename,lastname,generation,  will update user information (firstname,middlename,lastname,generation,
 permanentemail), and if forceid is true, student/employee ID also.  permanentemail), and if forceid is true, student/employee ID also.
 A user's institutional affiliation(s) can also be updated.  A user's institutional affiliation(s) can also be updated.
 User information fields will not be overwritten with empty entries  User information fields will not be overwritten with empty entries 
 unless the field is included in the $candelete array reference.  unless the field is included in the $candelete array reference.
 This array is included when a single user is modified via "Manage Users",  This array is included when a single user is modified via "Manage Users",
 or when Autoupdate.pl is run by cron in a domain.  or when Autoupdate.pl is run by cron in a domain.
Removed from v.1.1056.2.2  
changed lines
  Added in v.1.1060

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