Diff for /loncom/interface/lonprintout.pm between versions 1.383 and 1.386

version 1.383, 2005/08/15 22:39:43 version 1.386, 2005/08/16 10:25:15
Line 44  use Apache::lonlocal; Line 44  use Apache::lonlocal;
   
 my $resources_printed = '';  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  #  Determine if a code is a valid numeric code.  Valid
 #  numeric codes must be comprised entirely of digits and  #  numeric codes must be comprised entirely of digits and
 #  have a maximum number of allowable digits.  #  have a correct number of digits.
 #  #
 #  Parameters:  #  Parameters:
 #     value      - proposed code value.  #     value      - proposed code value.
 #     max_digits - Maximum digits allowed.  #     num_digits - Number of digits required.
 #  #
 sub is_valid_numeric_code {  sub is_valid_numeric_code {
     my ($value, $max_digits) = @_;      my ($value, $num_digits) = @_;
     #   Remove leading/trailing whitespace;      #   Remove leading/trailing whitespace;
     $value =~ s/^\s*//;      $value =~ s/^\s*//;
     $value =~ s/\s*$//;      $value =~ s/\s*$//;
           
     #  All digits?      #  All digits?
   
     if ($value =~ /^[0-9]+$/) {      if ($value =~ /^[0-9]+$/) {
  if (length($value) <= $max_digits) {  
     return undef;  
  } else {  
     return "Numeric code $value  has too many digits (max = $max_digits)";  
  }  
     } else {  
  return "Numeric code $value has invalid characters - must only be digits";   return "Numeric code $value has invalid characters - must only be digits";
     }      }
       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  #   Determines if a code is a valid alhpa code.  Alpha codes
 #   are ciphers that map  [A-J,a-j] -> 0..9 0..9.  #   are ciphers that map  [A-J,a-j] -> 0..9 0..9.
 #   They also have a maximum digit count.  #   They also have a correct digit count.
 # Parameters:  # Parameters:
 #     value          - Proposed code value.  #     value          - Proposed code value.
 #     max_letters    - Maximum number of letters.  #     num_letters    - correct number of letters.
 # Note:  # Note:
 #    leading and trailing whitespace are ignored.  #    leading and trailing whitespace are ignored.
 #  #
 sub is_valid_alpha_code {  sub is_valid_alpha_code {
     my ($value, $max_letters) = @_;      my ($value, $num_letters) = @_;
           
      # strip leading and trailing spaces.       # strip leading and trailing spaces.
   
Line 88  sub is_valid_alpha_code { Line 117  sub is_valid_alpha_code {
     $value =~ s/\s*$//g;      $value =~ s/\s*$//g;
   
     #  All alphas in the right range?      #  All alphas in the right range?
       if ($value !~ /^[A-J,a-j]+$/) {
     if ($value =~ /^[A-J,a-j]+$/) {  
  if (length($value) <= $max_letters) {  
     return undef;  
  } else {  
     return "Letter code $value has too many letters (max = $max_letters)";  
  }  
     } else {  
  return "Invalid letter code $value must only contain A-J";   return "Invalid letter code $value must only contain A-J";
     }      }
       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.  #   Determine if a code entered by the user in a helper is valid.
Line 129  sub is_code_valid { Line 155  sub is_code_valid {
     }      }
     my $valid;      my $valid;
     if ($code_type eq 'number') {      if ($code_type eq 'number') {
  $valid = &is_valid_numeric_code($code_value, $code_length);   return &is_valid_numeric_code($code_value, $code_length);
     } else {      } 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  #   Compare two students by name.  The students are in the form
Line 1338  ENDPART Line 1362  ENDPART
  my $num_todo=$helper->{'VARS'}->{'NUMBER_TO_PRINT_TOTAL'};   my $num_todo=$helper->{'VARS'}->{'NUMBER_TO_PRINT_TOTAL'};
  my $code_name=$helper->{'VARS'}->{'ANON_CODE_STORAGE_NAME'};   my $code_name=$helper->{'VARS'}->{'ANON_CODE_STORAGE_NAME'};
  my $old_name=$helper->{'VARS'}->{'REUSE_OLD_CODES'};   my $old_name=$helper->{'VARS'}->{'REUSE_OLD_CODES'};
      my $single_code = $helper->{'VARS'}->{'SINGLE_CODE'};
  my $code_option=$helper->{'VARS'}->{'CODE_OPTION'};   my $code_option=$helper->{'VARS'}->{'CODE_OPTION'};
  open(FH,$Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');   open(FH,$Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
  my ($code_type,$code_length)=('letter',6);   my ($code_type,$code_length)=('letter',6);
Line 1360  ENDPART Line 1384  ENDPART
      $code_type=$result{"type\0$old_name"};       $code_type=$result{"type\0$old_name"};
      @allcodes=split(',',$result{$old_name});       @allcodes=split(',',$result{$old_name});
      $num_todo=scalar(@allcodes);       $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 {   } else {
      my %allcodes;       my %allcodes;
      srand($seed);       srand($seed);
Line 1585  $r->print(<<FINALEND); Line 1619  $r->print(<<FINALEND);
 FINALEND  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 {  sub get_CODE {
     my ($all_codes,$num,$seed,$size,$type)=@_;      my ($all_codes,$num,$seed,$size,$type)=@_;
Line 2094  CHOOSE_STUDENTS Line 2120  CHOOSE_STUDENTS
     <message><b>Value of CODE to print?</b></td><td></message>      <message><b>Value of CODE to print?</b></td><td></message>
     <string variable="SINGLE_CODE" size="10" defaultvalue="zzzz">      <string variable="SINGLE_CODE" size="10" defaultvalue="zzzz">
         <validator>          <validator>
            # Not sure of exact call context so...  
    use Apache::lonprintout;  
    if(!\$helper->{'VARS'}{'NUMBER_TO_PRINT_TOTAL'}           &&     if(!\$helper->{'VARS'}{'NUMBER_TO_PRINT_TOTAL'}           &&
       !\$helper->{'VARS'}{'REUSE_OLD_CODES'}) {        !\$helper->{'VARS'}{'REUSE_OLD_CODES'}) {
       return &Apache::lonprintout::is_code_valid(\$helper->{'VARS'}{'SINGLE_CODE'},        return &Apache::lonprintout::is_code_valid(\$helper->{'VARS'}{'SINGLE_CODE'},
Line 2172  CHOOSE_STUDENTS1 Line 2196  CHOOSE_STUDENTS1
     <string variable="NUMBER_TO_PRINT_TOTAL" maxlength="5" size="5">      <string variable="NUMBER_TO_PRINT_TOTAL" maxlength="5" size="5">
        <validator>         <validator>
  if (((\$helper->{'VARS'}{'NUMBER_TO_PRINT_TOTAL'}+0) < 1) &&   if (((\$helper->{'VARS'}{'NUMBER_TO_PRINT_TOTAL'}+0) < 1) &&
     !\$helper->{'VARS'}{'REUSE_OLD_CODES'}) {      !\$helper->{'VARS'}{'REUSE_OLD_CODES'}                &&
       !\$helper->{'VARS'}{'SINGLE_CODE'}) {
     return "You need to specify the number of assignments to print";      return "You need to specify the number of assignments to print";
  }   }
  return undef;   return undef;
        </validator>         </validator>
     </string>      </string>
     <message></td></tr><tr><td></message>      <message></td></tr><tr><td></message>
       <message><b>Value of CODE to print?</b></td><td></message>
       <string variable="SINGLE_CODE" size="10" defaultvalue="zzzz">
           <validator>
      if(!\$helper->{'VARS'}{'NUMBER_TO_PRINT_TOTAL'}           &&
         !\$helper->{'VARS'}{'REUSE_OLD_CODES'}) {
         return &Apache::lonprintout::is_code_valid(\$helper->{'VARS'}{'SINGLE_CODE'},
         \$helper->{'VARS'}{'CODE_OPTION'});
      } else {
          return undef; # Other forces control us.
      }
           </validator>
       </string>
       <message></td></tr><tr><td></message>
     <message><b>Names to store the CODEs under for later:</b></message>      <message><b>Names to store the CODEs under for later:</b></message>
     <message></td><td></message>      <message></td><td></message>
     <string variable="ANON_CODE_STORAGE_NAME" maxlength="50" size="20" />      <string variable="ANON_CODE_STORAGE_NAME" maxlength="50" size="20" />

Removed from v.1.383  
changed lines
  Added in v.1.386


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