version 1.365, 2003/04/24 22:08:47
|
version 1.366, 2003/04/30 21:09:55
|
Line 3762 sub numval {
|
Line 3762 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 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); |
} |
} |
if (!$courseid) { $courseid=$ENV{'request.course.id'};} |
return &rndseed_32bit($symb,$courseid,$domain,$username); |
if (!$domain) {$domain=$ENV{'user.domain'};} |
} |
if (!$username) {$username=$ENV{'user.name'};} |
|
|
sub rndseed_32bit { |
|
my ($symb,$courseid,$domain,$username)=@_; |
{ |
{ |
use integer; |
use integer; |
my $symbchck=unpack("%32C*",$symb) << 27; |
my $symbchck=unpack("%32C*",$symb) << 27; |
my $symbseed=numval($symb) << 22; |
my $symbseed=numval($symb) << 22; |
my $namechck=unpack("%32C*",$username) << 17; |
my $namechck=unpack("%32C*",$username) << 17; |
my $nameseed=numval($username) << 12; |
my $nameseed=numval($username) << 12; |
my $domainseed=unpack("%32C*",$domain) << 7; |
my $domainseed=unpack("%32C*",$domain) << 7; |
my $courseseed=unpack("%32C*",$courseid); |
my $courseseed=unpack("%32C*",$courseid); |
my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck; |
my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck; |
#uncommenting these lines can break things! |
#&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"); |
return $num; |
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"; |
|
} |
|
} |
|
|
|
sub rndseed_CODE_64bit { |
|
my ($symb,$courseid,$domain,$username)=@_; |
|
{ |
|
use integer; |
|
my $symbchck=unpack("%32S*",$symb) << 16; |
|
my $symbseed=numval($symb); |
|
my $CODEseed=numval($ENV{'scantron.CODE'}) << 16; |
|
my $courseseed=unpack("%32S*",$courseid); |
|
my $num1=$symbseed+$CODEseed; |
|
my $num2=$courseseed+$symbchck; |
|
#&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck"); |
|
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); |
|
return "$num1,$num2"; |
|
} |
|
} |
|
|
|
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); |
} |
} |
} |
} |
|
|