[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.614 and 1.619

version 1.614, 2005/03/21 18:53:51 version 1.619, 2005/04/05 20:43:27
Line 40  qw(%perlvar %hostname %badServerCache %i Line 40  qw(%perlvar %hostname %badServerCache %i
    %courselogs %accesshash %userrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf     %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
    %domaindescription %domain_auth_def %domain_auth_arg_def      %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);     %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
      %env);
   
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
Line 54  use Cache::Memcached; Line 55  use Cache::Memcached;
 my $readit;  my $readit;
 my $max_connection_retries = 10;     # Or some such value.  my $max_connection_retries = 10;     # Or some such value.
   
   require Exporter;
   
   our @ISA = qw (Exporter);
   our @EXPORT = qw(%env);
   
 =pod  =pod
   
 =head1 Package Variables  =head1 Package Variables
Line 279  sub transfer_profile_to_env { Line 285  sub transfer_profile_to_env {
  chomp($profile[$envi]);   chomp($profile[$envi]);
  my ($envname,$envvalue)=split(/=/,$profile[$envi]);   my ($envname,$envvalue)=split(/=/,$profile[$envi]);
  $ENV{$envname} = $envvalue;   $ENV{$envname} = $envvalue;
    $env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {          if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {              if ($time < time-300) {
                 $Remove{$key}++;                  $Remove{$key}++;
Line 286  sub transfer_profile_to_env { Line 293  sub transfer_profile_to_env {
         }          }
     }      }
     $ENV{'user.environment'} = "$lonidsdir/$handle.id";      $ENV{'user.environment'} = "$lonidsdir/$handle.id";
       $env{'user.environment'} = "$lonidsdir/$handle.id";
     foreach my $expired_key (keys(%Remove)) {      foreach my $expired_key (keys(%Remove)) {
         &delenv($expired_key);          &delenv($expired_key);
     }      }
Line 303  sub appenv { Line 311  sub appenv {
     delete($newenv{$_});      delete($newenv{$_});
         } else {          } else {
             $ENV{$_}=$newenv{$_};              $ENV{$_}=$newenv{$_};
               $env{$_}=$newenv{$_};
         }          }
     }      }
   
Line 390  sub delenv { Line 399  sub delenv {
     if ($_=~/^$delthis/) {       if ($_=~/^$delthis/) { 
                 my ($key,undef) = split('=',$_);                  my ($key,undef) = split('=',$_);
                 delete($ENV{$key});                  delete($ENV{$key});
                   delete($env{$key});
             } else {              } else {
                 print $fh $_;                   print $fh $_; 
             }              }
Line 931  sub userenvironment { Line 941  sub userenvironment {
     return %returnhash;      return %returnhash;
 }  }
   
   # ---------------------------------------------------------- Get a studentphoto
   sub studentphoto {
       my ($udom,$unam,$ext) = @_;
       my $home=&Apache::lonnet::homeserver($unam,$udom);
       my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext",$home);
       my $url="/uploaded/$udom/$unam/internal/studentphoto.".$ext;
       if ($ret ne 'ok') {
    return '/adm/lonKaputt/lonlogo_broken.gif';
       }
       my $tokenurl=&Apache::lonnet::tokenwrapper($url);
       return $tokenurl;
   }
   
 # -------------------------------------------------------------------- New chat  # -------------------------------------------------------------------- New chat
   
 sub chatsend {  sub chatsend {
Line 3717  sub is_locked { Line 3740  sub is_locked {
     push @check, $file_name;      push @check, $file_name;
     my %locked = &get('file_permissions',\@check,      my %locked = &get('file_permissions',\@check,
       $ENV{'user.domain'},$ENV{'user.name'});        $ENV{'user.domain'},$ENV{'user.name'});
 #    my ($tmp)=keys(%locked);      my ($tmp)=keys(%locked);
 #    if ($tmp=~/^error:/) { undef(%locked); }      if ($tmp=~/^error:/) { undef(%locked); }
   
     if (ref($locked{$file_name}) eq 'ARRAY') {      if (ref($locked{$file_name}) eq 'ARRAY') {
         $is_locked = 'true';          $is_locked = 'true';
Line 3732  sub is_locked { Line 3755  sub is_locked {
 sub mark_as_readonly {  sub mark_as_readonly {
     my ($domain,$user,$files,$what) = @_;      my ($domain,$user,$files,$what) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
 #    my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
 #    if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     foreach my $file (@{$files}) {      foreach my $file (@{$files}) {
         push(@{$current_permissions{$file}},$what);          push(@{$current_permissions{$file}},$what);
Line 3816  sub files_not_in_path { Line 3839  sub files_not_in_path {
 sub get_marked_as_readonly {  sub get_marked_as_readonly {
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
 #    my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
 #    if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my @readonly_files;      my @readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {      while (my ($file_name,$value) = each(%current_permissions)) {
Line 3838  sub get_marked_as_readonly { Line 3861  sub get_marked_as_readonly {
 sub get_marked_as_readonly_hash {  sub get_marked_as_readonly_hash {
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
 #    my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
 #    if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my %readonly_files;      my %readonly_files;
     while (my ($file_name,$value) = each(%current_permissions)) {      while (my ($file_name,$value) = each(%current_permissions)) {
Line 3862  sub unmark_as_readonly { Line 3885  sub unmark_as_readonly {
     # for portfolio submissions, $what contains $crsid and $symb      # for portfolio submissions, $what contains $crsid and $symb
     my ($domain,$user,$what) = @_;      my ($domain,$user,$what) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);      my %current_permissions = &dump('file_permissions',$domain,$user);
 #    my ($tmp)=keys(%current_permissions);      my ($tmp)=keys(%current_permissions);
 #    if ($tmp=~/^error:/) { undef(%current_permissions); }      if ($tmp=~/^error:/) { undef(%current_permissions); }
   
     my @readonly_files = &get_marked_as_readonly($domain,$user,$what);      my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
     foreach my $file(@readonly_files){      foreach my $file(@readonly_files){
Line 4160  sub EXT { Line 4183  sub EXT {
     if ($realm eq 'user') {      if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource  # --------------------------------------------------------------- user.resource
  if ($space eq 'resource') {   if ($space eq 'resource') {
     if (defined($Apache::lonhomework::parsing_a_problem)) {      if (defined($Apache::lonhomework::parsing_a_problem) ||
    defined($Apache::lonhomework::parsing_a_task)) {
  return $Apache::lonhomework::history{$qualifierrest};   return $Apache::lonhomework::history{$qualifierrest};
     } else {      } else {
  my %restored;   my %restored;
Line 4713  sub get_slot { Line 4737  sub get_slot {
     &Apache::lonhomework::showhash(%slotinfo);      &Apache::lonhomework::showhash(%slotinfo);
     my ($tmp)=keys(%slotinfo);      my ($tmp)=keys(%slotinfo);
     if ($tmp=~/^error:/) { return (); }      if ($tmp=~/^error:/) { return (); }
     return %{$slotinfo{$which}};      if (ref($slotinfo{$which}) eq 'HASH') {
    return %{$slotinfo{$which}};
       }
       return $slotinfo{$which};
 }  }
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
   
Line 5007  sub validCODE { Line 5034  sub validCODE {
   
 sub getCODE {  sub getCODE {
     if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }      if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
     if (defined($Apache::lonhomework::parsing_a_problem) &&      if ( (defined($Apache::lonhomework::parsing_a_problem) ||
  &validCODE($Apache::lonhomework::history{'resource.CODE'})) {    defined($Apache::lonhomework::parsing_a_task) ) &&
    &validCODE($Apache::lonhomework::history{'resource.CODE'})) {
  return $Apache::lonhomework::history{'resource.CODE'};   return $Apache::lonhomework::history{'resource.CODE'};
     }      }
     return undef;      return undef;
Line 5635  BEGIN { Line 5663  BEGIN {
        }         }
     }      }
     close($config);      close($config);
       # FIXME: dev server don't want this, production servers _do_ want this
       #&get_iphost();
 }  }
   
 sub get_iphost {  sub get_iphost {
Removed from v.1.614  
changed lines
  Added in v.1.619

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