[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.558 and 1.566

version 1.558, 2004/11/02 23:22:47 version 1.566, 2004/11/10 06:02:11
Line 40  qw(%perlvar %hostname %homecache %badSer Line 40  qw(%perlvar %hostname %homecache %badSer
    %courselogs %accesshash %userrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache      %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache 
    %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def      %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);     %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);
   
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
Line 1188  sub ssi_body { Line 1188  sub ssi_body {
     my ($filelink,%form)=@_;      my ($filelink,%form)=@_;
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));                                       &ssi($filelink,%form));
     $output=~      $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+// END LON-CAPA Internal\s*(-->)?\s||gs;
             s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;  
     $output=~s/^.*?\<body[^\>]*\>//si;      $output=~s/^.*?\<body[^\>]*\>//si;
     $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;      $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
     return $output;      return $output;
Line 3781  sub diskusage { Line 3780  sub diskusage {
     return $listing;      return $listing;
 }  }
   
   sub is_locked {
       my ($file_name, $domain, $user) = @_;
       my @check;
       my $is_locked;
       push @check, $file_name;
       my %locked = &Apache::lonnet::get('file_permissions',\@check,
                                           $ENV{'user.domain'},$ENV{'user.name'});
       if (ref($locked{$file_name}) eq 'ARRAY') {
           $is_locked = 'true';
       } else {
           $is_locked = 'false';
       }
   }
   
   # ------------------------------------------------------------- Mark as Read Only
   
   sub mark_as_readonly {
       my ($domain,$user,$files,$what) = @_;
       my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
       foreach my $file (@{$files}) {
           push(@{$current_permissions{$file}},$what);
       }
       &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
       return;
   }
   
   #--------------------------------------------------------------Get Marked as Read Only
   
   sub get_marked_as_readonly {
       my ($domain,$user,$what) = @_;
       my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
       my @readonly_files;
       while (my ($file_name,$value) = each(%current_permissions)) {
           if (ref($value) eq "ARRAY"){
               foreach my $stored_what (@{$value}) {
                   if ($stored_what eq $what) {
                       push(@readonly_files, $file_name);
                   } elsif (!defined($what)) {
                       push(@readonly_files, $file_name);
                   }
               }
           } 
       }
       return @readonly_files;
   }
   
   # ------------------------------------------------------------ Unmark as Read Only
   
   sub unmark_as_readonly {
       # unmarks all files locked by $what 
       # for portfolio submissions, $what contains $crsid and $symb
       my ($domain,$user,$what) = @_;
       my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
       my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what);
       foreach my $file(@readonly_files){
           my $current_locks = $current_permissions{$file};
           my @new_locks;
           my @del_keys;
           if (ref($current_locks) eq "ARRAY"){
               foreach my $locker (@{$current_locks}) {
                   unless ($locker eq $what) {
                       push(@new_locks, $what);
                   }
               }
               if (@new_locks > 0) {
                   $current_permissions{$file} = \@new_locks;
               } else {
                   push(@del_keys, $file);
                   &Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user);
                   delete $current_permissions{$file};
               }
           }
       }
       &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
       return;
   }
   
 # ------------------------------------------------------------ Directory lister  # ------------------------------------------------------------ Directory lister
   
Line 4792  sub numval { Line 4867  sub numval {
     $txt=~tr/U-Z/0-5/;      $txt=~tr/U-Z/0-5/;
     $txt=~tr/u-z/0-5/;      $txt=~tr/u-z/0-5/;
     $txt=~s/\D//g;      $txt=~s/\D//g;
       if ($_64bit) { if ($txt > 2**32) { return -1; } }
     return int($txt);      return int($txt);
 }  }
   
Line 4807  sub numval2 { Line 4883  sub numval2 {
     my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);      my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);
     my $total;      my $total;
     foreach my $val (@txts) { $total+=$val; }      foreach my $val (@txts) { $total+=$val; }
       if ($_64bit) { if ($total > 2**32) { return -1; } }
     return int($total);      return int($total);
 }  }
   
Line 4823  sub get_rand_alg { Line 4900  sub get_rand_alg {
     return &latest_rnd_algorithm_id();      return &latest_rnd_algorithm_id();
 }  }
   
   sub validCODE {
       my ($CODE)=@_;
       if (defined($CODE) && $CODE ne '' && $CODE =~ /^\w+$/) { return 1; }
       return 0;
   }
   
 sub getCODE {  sub getCODE {
     if (defined($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) &&
  defined($Apache::lonhomework::history{'resource.CODE'})) {   &validCODE($Apache::lonhomework::history{'resource.CODE'})) {
  return $Apache::lonhomework::history{'resource.CODE'};   return $Apache::lonhomework::history{'resource.CODE'};
     }      }
     return undef;      return undef;
Line 4868  sub rndseed_32bit { Line 4951  sub rndseed_32bit {
  my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;   my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
  #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");   #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
  #&Apache::lonxml::debug("rndseed :$num:$symb");   #&Apache::lonxml::debug("rndseed :$num:$symb");
    if ($_64bit) { $num=(($num<<32)>>32); }
  return $num;   return $num;
     }      }
 }  }
Line 4888  sub rndseed_64bit { Line 4972  sub rndseed_64bit {
  my $num2=$nameseed+$domainseed+$courseseed;   my $num2=$nameseed+$domainseed+$courseseed;
  #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");   #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
  #&Apache::lonxml::debug("rndseed :$num:$symb");   #&Apache::lonxml::debug("rndseed :$num:$symb");
    if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
    if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
  return "$num1,$num2";   return "$num1,$num2";
     }      }
 }  }
Line 4931  sub rndseed_64bit3 { Line 5017  sub rndseed_64bit3 {
  my $num1=$symbchck+$symbseed+$namechck;   my $num1=$symbchck+$symbseed+$namechck;
  my $num2=$nameseed+$domainseed+$courseseed;   my $num2=$nameseed+$domainseed+$courseseed;
  #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");   #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
  #&Apache::lonxml::debug("rndseed :$num:$symb");   #&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit");
    if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
   
  return "$num1:$num2";   return "$num1:$num2";
     }      }
 }  }
Line 4949  sub rndseed_CODE_64bit { Line 5037  sub rndseed_CODE_64bit {
  my $num2=$CODEseed+$courseseed+$symbchck;   my $num2=$CODEseed+$courseseed+$symbchck;
  #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");   #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
  #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");   #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
    if ($_64bit) { $num1=(($num1<<32)>>32); }
    if ($_64bit) { $num2=(($num2<<32)>>32); }
  return "$num1:$num2";   return "$num1:$num2";
     }      }
 }  }
Line 5469  $dumpcount=0; Line 5559  $dumpcount=0;
 &logtouch();  &logtouch();
 &logthis('<font color=yellow>INFO: Read configuration</font>');  &logthis('<font color=yellow>INFO: Read configuration</font>');
 $readit=1;  $readit=1;
       {
    use integer;
    my $test=(2**32)+1;
    if ($test != 0) { $_64bit=1; }
    &logthis(" Detected 64bit platform ($_64bit)");
       }
 }  }
 }  }
   
Removed from v.1.558  
changed lines
  Added in v.1.566

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