[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[albertel]

albertel		Wed Apr 30 17:09:55 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - new rndseed functions, 64bit looks pretty tasty
  
  - let me know if you see any issues with this
  
  (should be backward compatible I have seen no fluxes)
  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.365 loncom/lonnet/perl/lonnet.pm:1.366
--- loncom/lonnet/perl/lonnet.pm:1.365	Thu Apr 24 18:08:47 2003
+++ loncom/lonnet/perl/lonnet.pm	Wed Apr 30 17:09:55 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.365 2003/04/24 22:08:47 albertel Exp $
+# $Id: lonnet.pm,v 1.366 2003/04/30 21:09:55 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3762,29 +3762,88 @@
     $txt=~tr/u-z/0-5/;
     $txt=~s/\D//g;
     return int($txt);
-}    
+}
 
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
+
+    my ($wsymb,$wcourseid,$wdomain,$wusername)=&Apache::lonxml::whichuser();
     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;
-      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;
-      #uncommenting these lines can break things!
-      #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-      #&Apache::lonxml::debug("rndseed :$num:$symb");
-      return $num;
+	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);
     }
 }