Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.365 and 1.368

version 1.365, 2003/04/24 22:08:47 version 1.368, 2003/05/04 07:38:32
Line 650  sub comment_access_key { Line 650  sub comment_access_key {
     if ($existing{$ckey}) {      if ($existing{$ckey}) {
         $existing{$ckey}.='; '.$logentry;          $existing{$ckey}.='; '.$logentry;
 # ready to assign  # ready to assign
         $logentry=$1.'; '.$logentry;          if (&put('accesskeys',{$ckey=>$existing{$ckey}},
         if (&put('accesskey',{$ckey=>$existing{$ckey}},  
                                                  $cdom,$cnum) eq 'ok') {                                                   $cdom,$cnum) eq 'ok') {
     return 'ok';      return 'ok';
         } else {          } else {
Line 3762  sub numval { Line 3761  sub numval {
     $txt=~tr/u-z/0-5/;      $txt=~tr/u-z/0-5/;
     $txt=~s/\D//g;      $txt=~s/\D//g;
     return int($txt);      return int($txt);
 }      }
   
   sub latest_rnd_algorithm_id {
       return '64bit';
   }
   
 sub rndseed {  sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username)=@_;
   
       my ($wsymb,$wcourseid,$wdomain,$wusername)=&Apache::lonxml::whichuser();
     if (!$symb) {      if (!$symb) {
       unless ($symb=&symbread()) { return time; }   unless ($symb=$wsymb) { return time; }
       }
       if (!$courseid) { $courseid=$wcourseid; }
       if (!$domain) { $domain=$wdomain; }
       if (!$username) { $username=$wusername }
       my $which=$ENV{"course.$courseid.rndseed"};
       my $CODE=$ENV{'scantron.CODE'};
       if (defined($CODE)) {
    &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
       } elsif ($which eq '64bit') {
    return &rndseed_64bit($symb,$courseid,$domain,$username);
       }
       return &rndseed_32bit($symb,$courseid,$domain,$username);
   }
   
   sub rndseed_32bit {
       my ($symb,$courseid,$domain,$username)=@_;
       {
    use integer;
    my $symbchck=unpack("%32C*",$symb) << 27;
    my $symbseed=numval($symb) << 22;
    my $namechck=unpack("%32C*",$username) << 17;
    my $nameseed=numval($username) << 12;
    my $domainseed=unpack("%32C*",$domain) << 7;
    my $courseseed=unpack("%32C*",$courseid);
    my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
    #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
    #&Apache::lonxml::debug("rndseed :$num:$symb");
    return $num;
       }
   }
   
   sub rndseed_64bit {
       my ($symb,$courseid,$domain,$username)=@_;
       {
    use integer;
    my $symbchck=unpack("%32S*",$symb) << 21;
    my $symbseed=numval($symb) << 10;
    my $namechck=unpack("%32S*",$username);
   
    my $nameseed=numval($username) << 21;
    my $domainseed=unpack("%32S*",$domain) << 10;
    my $courseseed=unpack("%32S*",$courseid);
   
    my $num1=$symbchck+$symbseed+$namechck;
    my $num2=$nameseed+$domainseed+$courseseed;
    #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
    #&Apache::lonxml::debug("rndseed :$num:$symb");
    return "$num1,$num2";
     }      }
     if (!$courseid) { $courseid=$ENV{'request.course.id'};}  }
     if (!$domain) {$domain=$ENV{'user.domain'};}  
     if (!$username) {$username=$ENV{'user.name'};}  sub rndseed_CODE_64bit {
       my ($symb,$courseid,$domain,$username)=@_;
     {      {
       use integer;   use integer;
       my $symbchck=unpack("%32C*",$symb) << 27;   my $symbchck=unpack("%32S*",$symb) << 16;
       my $symbseed=numval($symb) << 22;   my $symbseed=numval($symb);
       my $namechck=unpack("%32C*",$username) << 17;   my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
       my $nameseed=numval($username) << 12;   my $courseseed=unpack("%32S*",$courseid);
       my $domainseed=unpack("%32C*",$domain) << 7;   my $num1=$symbseed+$CODEseed;
       my $courseseed=unpack("%32C*",$courseid);   my $num2=$courseseed+$symbchck;
       my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;   #&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");
       #uncommenting these lines can break things!   #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
       #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");   return "$num1,$num2";
       #&Apache::lonxml::debug("rndseed :$num:$symb");      }
       return $num;  }
   
   sub setup_random_from_rndseed {
       my ($rndseed)=@_;
       if ($rndseed =~/,/) {
    my ($num1,$num2)=split(/,/,$rndseed);
    &Math::Random::random_set_seed(abs($num1),abs($num2));
       } else {
    &Math::Random::random_set_seed_from_phrase($rndseed);
     }      }
 }  }
   

Removed from v.1.365  
changed lines
  Added in v.1.368


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