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

[albertel]

albertel		Wed May 12 15:48:52 2004 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - new rndseed alg.
          - numval doesn't return a 32bit integer, numval2 does
            
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.500 loncom/lonnet/perl/lonnet.pm:1.501
--- loncom/lonnet/perl/lonnet.pm:1.500	Tue May 11 02:49:58 2004
+++ loncom/lonnet/perl/lonnet.pm	Wed May 12 15:48:51 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.500 2004/05/11 06:49:58 albertel Exp $
+# $Id: lonnet.pm,v 1.501 2004/05/12 19:48:51 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4462,7 +4462,7 @@
 }
 
 sub latest_rnd_algorithm_id {
-    return '64bit2';
+    return '64bit3';
 }
 
 sub getCODE {
@@ -4487,6 +4487,8 @@
     my $which=$ENV{"course.$courseid.rndseed"};
     if (defined(&getCODE())) {
 	return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+    } elsif ($which eq '64bit3') {
+	return &rndseed_64bit3($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit2') {
 	return &rndseed_64bit2($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit') {
@@ -4543,6 +4545,28 @@
 	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_64bit3 {
+    my ($symb,$courseid,$domain,$username)=@_;
+    {
+	use integer;
+	# strings need to be an even # of cahracters long, it it is odd the
+        # last characters gets thrown away
+	my $symbchck=unpack("%32S*",$symb.' ') << 21;
+	my $symbseed=numval2($symb) << 10;
+	my $namechck=unpack("%32S*",$username.' ');
+	
+	my $nameseed=numval2($username) << 21;
 	my $domainseed=unpack("%32S*",$domain.' ') << 10;
 	my $courseseed=unpack("%32S*",$courseid.' ');