Diff for /loncom/interface/lonprintout.pm between versions 1.382 and 1.388

version 1.382, 2005/08/15 21:51:49 version 1.388, 2005/08/22 22:21:48
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
   #  numeric codes must be comprised entirely of digits and
   #  have a correct number of digits.
   #
   #  Parameters:
   #     value      - proposed code value.
   #     num_digits - Number of digits required.
   #
   sub is_valid_numeric_code {
       my ($value, $num_digits) = @_;
       #   Remove leading/trailing whitespace;
       $value =~ s/^\s*//g;
       $value =~ s/\s*$//g;
       
       #  All digits?
       if ($value !~ /^[0-9]+$/) {
    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
   #   are ciphers that map  [A-J,a-j] -> 0..9 0..9.
   #   They also have a correct digit count.
   # Parameters:
   #     value          - Proposed code value.
   #     num_letters    - correct number of letters.
   # Note:
   #    leading and trailing whitespace are ignored.
   #
   sub is_valid_alpha_code {
       my ($value, $num_letters) = @_;
       
        # strip leading and trailing spaces.
   
       $value =~ s/^\s*//g;
       $value =~ s/\s*$//g;
   
       #  All alphas in the right range?
       if ($value !~ /^[A-J,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.
 #   valid depends on the code type and the type of code selected.  #   valid depends on the code type and the type of code selected.
 #   The type of code selected can either be numeric or   #   The type of code selected can either be numeric or 
Line 60  my $resources_printed = ''; Line 142  my $resources_printed = '';
 #  #
 sub is_code_valid {  sub is_code_valid {
     my ($code_value, $code_option) = @_;      my ($code_value, $code_option) = @_;
       my ($code_type, $code_length) = ('letter', 6); # defaults.
       open(FG, $Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
       foreach my $line (<FG>) {
    my ($name, $type, $length) = (split(/:/, $line))[0,2,4];
    if($name eq $code_option) {
       $code_length = $length;
       if($type eq 'number') {
    $code_type = 'number';
       }
    }
       }
       my $valid;
       if ($code_type eq 'number') {
    return &is_valid_numeric_code($code_value, $code_length);
       } else {
    return &is_valid_alpha_code($code_value, $code_length);
       }
   
     return "Entering a single code is not supported (yet)";  
 }  }
   
 #   Compare two students by name.  The students are in the form  #   Compare two students by name.  The students are in the form
Line 1264  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 $selected_code = $helper->{'VARS'}->{'CODE_SELECTED_FROM_LIST'};
   
  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 1286  ENDPART Line 1386  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 ($selected_code) {
        $num_todo = 1;
        my ($alpha, $numeric) = split(/:/, $selected_code);
        $selected_code = $numeric; # Always use numeric, converted if need be.
        $selected_code =~ s/\s+//g;
        @allcodes = ($selected_code);
    } elsif ($single_code) {
   
        $num_todo    = 1; # Unconditionally one code to do.
        # 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);
        }
        @allcodes = ($single_code);
  } else {   } else {
      my %allcodes;       my %allcodes;
      srand($seed);       srand($seed);
Line 1511  $r->print(<<FINALEND); Line 1627  $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 1988  CHOOSE_STUDENTS Line 2096  CHOOSE_STUDENTS
     if ($name =~ /^type\0/) { next; }      if ($name =~ /^type\0/) { next; }
     $namechoice.='<choice computer="'.$name.'">'.$name.'</choice>';      $namechoice.='<choice computer="'.$name.'">'.$name.'</choice>';
  }   }
           my %all_codes = &Apache::lonnet::get('CODEs',
        \@names, $cdom,$cnum);
    my @all_code_array;
    foreach my $key (keys %all_codes) {
       my $codes = $all_codes{$key};
       my @numeric_codes = split(/,/,$codes);
       foreach my $numeric (sort {uc($a) cmp uc($b)} @numeric_codes) {
    my $alpha_code = &num_to_letters($numeric);
    push (@all_code_array, "$alpha_code : $numeric");
       }
    }
    my $code_selection = "<choice></choice>\n";
    foreach my $code (@all_code_array) {
       $code_selection .= '   <choice computer="'.$code.'">'.$code."</choice>\n";
    }
  open(FH,$Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');   open(FH,$Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
  my $codechoice='';   my $codechoice='';
  foreach my $line (<FH>) {   foreach my $line (<FH>) {
Line 2010  CHOOSE_STUDENTS Line 2133  CHOOSE_STUDENTS
        <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'}) {              !\$helper->{'VARS'}{'SINGLE_CODE'}                    &&
       !\$helper->{'VARS'}{'CODE_SELECTED_FROM_LIST'}) {
     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;
Line 2020  CHOOSE_STUDENTS Line 2144  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'}                 &&
         !\$helper->{'VARS'}{'CODE_SELECTED_FROM_LIST'}) {
       return &Apache::lonprintout::is_code_valid(\$helper->{'VARS'}{'SINGLE_CODE'},        return &Apache::lonprintout::is_code_valid(\$helper->{'VARS'}{'SINGLE_CODE'},
       \$helper->{'VARS'}{'CODE_OPTION'});        \$helper->{'VARS'}{'CODE_OPTION'});
    } else {     } else {
Line 2032  CHOOSE_STUDENTS Line 2155  CHOOSE_STUDENTS
         </validator>          </validator>
     </string>      </string>
     <message></td></tr><tr><td></message>      <message></td></tr><tr><td></message>
       <message><b>Choose single code from list</b></message>
       <message></td><td></message>
       <dropdown variable="CODE_SELECTED_FROM_LIST" multichoice="0" allowempty="0">
       $code_selection
       </dropdown>
       <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" />
Line 2098  CHOOSE_STUDENTS1 Line 2227  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'}                   &&
       !\$helper->{'VARS'}{'CODE_SELECTED_FROM_LIST'}) {
     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'}                 &&
         !\$helper->{'VARS'}{'CODE_SELECTED_FROM_LIST'}) {
         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>Choose single code from list</b></message>
       <message></td><td></message>
       <dropdown variable="CODE_SELECTED_FROM_LIST" multichoice="0" allowempty="0">
       $code_selection
       </dropdown>
       <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.382  
changed lines
  Added in v.1.388


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