[LON-CAPA-cvs] cvs: loncom /interface lonprintout.pm

[foxr]

foxr		Tue Aug 16 06:11:27 2005 EDT

  Modified files:              
    /loncom/interface	lonprintout.pm 
  Log:
  Got print problems for anonymous with single typed in code to work
  On to the same for resources... may later put in a chooser for known
  codes but will still need to allow the type-in of a code that was not
  saved.
  
  
Index: loncom/interface/lonprintout.pm
diff -u loncom/interface/lonprintout.pm:1.384 loncom/interface/lonprintout.pm:1.385
--- loncom/interface/lonprintout.pm:1.384	Mon Aug 15 23:34:34 2005
+++ loncom/interface/lonprintout.pm	Tue Aug 16 06:11:24 2005
@@ -1,7 +1,7 @@
 #  The LearningOnline Network
 # Printout
 #
-# $Id: lonprintout.pm,v 1.384 2005/08/16 03:34:34 albertel Exp $
+# $Id: lonprintout.pm,v 1.385 2005/08/16 10:11:24 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -44,6 +44,38 @@
 
 my $resources_printed = '';
 
+#
+#   Convert a numeric code to letters
+#
+sub num_to_letters {
+    my ($num) = @_;
+    my @nums= split('',$num);
+    my @num_to_let=('A'..'Z');
+    my $word;
+    foreach my $digit (@nums) { $word.=$num_to_let[$digit]; }
+    return $word;
+}
+#   Convert a letter code to numeric.
+#
+sub letters_to_num {
+    my ($letters) = @_;
+    my @letters = split('', uc($letters));
+    my %substitution;
+    my $digit = 0;
+    foreach my $letter ('A'..'J') {
+	$substitution{$letter} = $digit;
+	$digit++;
+    }
+    #  The substitution is done as below to preserve leading
+    #  zeroes which are needed to keep the code size exact
+    #
+    my $result ="";
+    foreach my $letter (@letters) {
+	$result.=$substitution{$letter};
+    }
+    return $result;
+}
+
 #  Determine if a code is a valid numeric code.  Valid
 #  numeric codes must be comprised entirely of digits and
 #  have a correct number of digits.
@@ -65,6 +97,7 @@
     if (length($value) != $num_digits) {
 	return "Numeric code $value incorrect number of digits (correct = $num_digits)";
     }
+    return undef;
 }
 #   Determines if a code is a valid alhpa code.  Alpha codes
 #   are ciphers that map  [A-J,a-j] -> 0..9 0..9.
@@ -90,6 +123,7 @@
     if (length($value) != $num_letters) {
 	return "Letter code $value has incorrect number of letters (correct = $num_letters)";
     }
+    return undef;
 }
 
 #   Determine if a code entered by the user in a helper is valid.
@@ -121,12 +155,11 @@
     }
     my $valid;
     if ($code_type eq 'number') {
-	$valid = &is_valid_numeric_code($code_value, $code_length);
+	return &is_valid_numeric_code($code_value, $code_length);
     } else {
-	$valid = &is_valid_alpha_code($code_value, $code_length);
+	return &is_valid_alpha_code($code_value, $code_length);
     }
 
-    return "Entering a single code is not supported (yet): $code_type $code_length $valid";
 }
 
 #   Compare two students by name.  The students are in the form
@@ -1329,7 +1362,7 @@
 	 my $num_todo=$helper->{'VARS'}->{'NUMBER_TO_PRINT_TOTAL'};
 	 my $code_name=$helper->{'VARS'}->{'ANON_CODE_STORAGE_NAME'};
 	 my $old_name=$helper->{'VARS'}->{'REUSE_OLD_CODES'};
-	 
+	 my $single_code = $helper->{'VARS'}->{'SINGLE_CODE'};
 	 my $code_option=$helper->{'VARS'}->{'CODE_OPTION'};
 	 open(FH,$Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
 	 my ($code_type,$code_length)=('letter',6);
@@ -1351,6 +1384,16 @@
 	     $code_type=$result{"type\0$old_name"};
 	     @allcodes=split(',',$result{$old_name});
 	     $num_todo=scalar(@allcodes);
+	 } elsif ($single_code) {
+
+	     # If an alpha code have to convert to numbers so it can be
+	     # converted back to letters again :-)
+	     #
+	     if ($code_type ne 'number') {
+		 $single_code = &letters_to_num($single_code);
+		 $num_todo    = 1;
+	     }
+	     @allcodes = ($single_code);
 	 } else {
 	     my %allcodes;
 	     srand($seed);
@@ -1576,14 +1619,6 @@
 FINALEND
 }
 
-sub num_to_letters {
-    my ($num) = @_;
-    my @nums= split('',$num);
-    my @num_to_let=('A'..'Z');
-    my $word;
-    foreach my $digit (@nums) { $word.=$num_to_let[$digit]; }
-    return $word;
-}
 
 sub get_CODE {
     my ($all_codes,$num,$seed,$size,$type)=@_;