[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.554 and 1.558

version 1.554, 2004/10/26 17:20:09 version 1.558, 2004/11/02 23:22:47
Line 47  use GDBM_File; Line 47  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use HTML::LCParser;  use HTML::LCParser;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::loncoursedata;  
 use Apache::lonlocal;  use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw);  use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );  use Time::HiRes qw( gettimeofday tv_interval );
 my $readit;  my $readit;
 my $max_connection_retries = 10;     # Or some such value.  my $max_connection_retries = 10;     # Or some such value.
Line 2470  sub rolesinit { Line 2469  sub rolesinit {
         my $author=0;          my $author=0;
         foreach (keys %allroles) {          foreach (keys %allroles) {
             %thesepriv=();              %thesepriv=();
             if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }  
             if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }              if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
             foreach (split(/:/,$allroles{$_})) {              foreach (split(/:/,$allroles{$_})) {
                 if ($_ ne '') {                  if ($_ ne '') {
Line 2482  sub rolesinit { Line 2480  sub rolesinit {
     $thesepriv{$privilege}.=$restrictions;      $thesepriv{$privilege}.=$restrictions;
                         }                          }
                     }                      }
       if ($thesepriv{'adv'} eq 'F') { $adv=1; }
                 }                  }
             }              }
             $thesestr='';              $thesestr='';
Line 2516  sub get { Line 2515  sub get {
    my %returnhash=();     my %returnhash=();
    my $i=0;     my $i=0;
    foreach (@$storearr) {     foreach (@$storearr) {
       $returnhash{$_}=unescape($pairs[$i]);        $returnhash{$_}=&thaw_unescape($pairs[$i]);
       $i++;        $i++;
    }     }
    return %returnhash;     return %returnhash;
Line 2555  sub dump { Line 2554  sub dump {
    my %returnhash=();     my %returnhash=();
    foreach (@pairs) {     foreach (@pairs) {
       my ($key,$value)=split(/=/,$_);        my ($key,$value)=split(/=/,$_);
       $returnhash{unescape($key)}=unescape($value);        $returnhash{unescape($key)}=&thaw_unescape($value);
    }     }
    return %returnhash;     return %returnhash;
 }  }
Line 2601  sub currentdump { Line 2600  sub currentdump {
            my ($key,$value)=split(/=/,$_);             my ($key,$value)=split(/=/,$_);
            my ($symb,$param) = split(/:/,$key);             my ($symb,$param) = split(/:/,$key);
            $returnhash{&unescape($symb)}->{&unescape($param)} =              $returnhash{&unescape($symb)}->{&unescape($param)} = 
                                                           &unescape($value);                                                          &thaw_unescape($value);
        }         }
    }     }
    return %returnhash;     return %returnhash;
Line 2667  sub put { Line 2666  sub put {
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $items='';     my $items='';
    foreach (keys %$storehash) {     foreach (keys %$storehash) {
        $items.=&escape($_).'='.&escape($$storehash{$_}).'&';         $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
Line 2706  sub cput { Line 2705  sub cput {
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $items='';     my $items='';
    foreach (keys %$storehash) {     foreach (keys %$storehash) {
        $items.=escape($_).'='.escape($$storehash{$_}).'&';         $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    return &critical("put:$udomain:$uname:$namespace:$items",$uhome);     return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
Line 2729  sub eget { Line 2728  sub eget {
    my %returnhash=();     my %returnhash=();
    my $i=0;     my $i=0;
    foreach (@$storearr) {     foreach (@$storearr) {
       $returnhash{$_}=unescape($pairs[$i]);        $returnhash{$_}=&thaw_unescape($pairs[$i]);
       $i++;        $i++;
    }     }
    return %returnhash;     return %returnhash;
Line 3058  sub allowed { Line 3057  sub allowed {
             return '';               return ''; 
          }           }
       }        }
       if (!defined($ENV{'user.state.'.$ENV{'request.course.id'}})) {  
   &Apache::lonuserstate::evalstate();  
       }  
       if (&condval($statecond)) {        if (&condval($statecond)) {
  return '2';   return '2';
       } else {        } else {
Line 3631  sub modify_student_enrollment { Line 3627  sub modify_student_enrollment {
         $gene   = $tmp{'generation'} if (!defined($gene)   || $gene eq '');          $gene   = $tmp{'generation'} if (!defined($gene)   || $gene eq '');
         $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');          $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');
     }      }
     my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,      my $fullname = &format_name($first,$middle,$last,$gene,'lastname');
                                                            $first,$middle);  
     my $reply=cput('classlist',      my $reply=cput('classlist',
    {"$uname:$udom" =>      {"$uname:$udom" => 
  join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },   join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },
Line 3649  sub modify_student_enrollment { Line 3644  sub modify_student_enrollment {
     return &assignrole($udom,$uname,$uurl,'st',$end,$start);      return &assignrole($udom,$uname,$uurl,'st',$end,$start);
 }  }
   
   sub format_name {
       my ($firstname,$middlename,$lastname,$generation,$first)=@_;
       my $name;
       if ($first ne 'lastname') {
    $name=$firstname.' '.$middlename.' '.$lastname.' '.$generation;
       } else {
    if ($lastname=~/\S/) {
       $name.= $lastname.' '.$generation.', '.$firstname.' '.$middlename;
       $name=~s/\s+,/,/;
    } else {
       $name.= $firstname.' '.$middlename.' '.$generation;
    }
       }
       $name=~s/^\s+//;
       $name=~s/\s+$//;
       $name=~s/\s+/ /g;
       return $name;
   }
   
 # ------------------------------------------------- Write to course preferences  # ------------------------------------------------- Write to course preferences
   
 sub writecoursepref {  sub writecoursepref {
Line 3876  sub GetFileTimestamp { Line 3890  sub GetFileTimestamp {
   
 sub directcondval {  sub directcondval {
     my $number=shift;      my $number=shift;
       if (!defined($ENV{'user.state.'.$ENV{'request.course.id'}})) {
    &Apache::lonuserstate::evalstate();
       }
     if ($ENV{'user.state.'.$ENV{'request.course.id'}}) {      if ($ENV{'user.state.'.$ENV{'request.course.id'}}) {
        return substr($ENV{'user.state.'.$ENV{'request.course.id'}},$number,1);         return substr($ENV{'user.state.'.$ENV{'request.course.id'}},$number,1);
     } else {      } else {
Line 5237  sub clutter { Line 5254  sub clutter {
     return $thisfn;      return $thisfn;
 }  }
   
   sub freeze_escape {
       my ($value)=@_;
       if (ref($value)) {
    $value=&nfreeze($value);
    return '__FROZEN__'.&escape($value);
       }
       return &escape($value);
   }
   
 # -------------------------------------------------------- Escape Special Chars  # -------------------------------------------------------- Escape Special Chars
   
 sub escape {  sub escape {
Line 5253  sub unescape { Line 5279  sub unescape {
     return $str;      return $str;
 }  }
   
   sub thaw_unescape {
       my ($value)=@_;
       if ($value =~ /^__FROZEN__/) {
    substr($value,0,10,undef);
    $value=&unescape($value);
    return &thaw($value);
       }
       return &unescape($value);
   }
   
 sub mod_perl_version {  sub mod_perl_version {
     if (defined($perlvar{'MODPERL2'})) {      if (defined($perlvar{'MODPERL2'})) {
  return 2;   return 2;
Removed from v.1.554  
changed lines
  Added in v.1.558

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