loncom/interface/lonprintout.pm - diff

Return to lonprintout.pm CVS log

Up to [LON-CAPA] / loncom / interface

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

-version 1.382, 2005/08/15 21:51:49
+version 1.384, 2005/08/16 03:34:34
  Line 44  use Apache::lonlocal;
  my $resources_printed = '';
+ #  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*//;
+     $value =~ s/\s*$//;
+     #  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)";
+     }
+ }
+ #   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)";
+     }
+ }
  #   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.
  #   The type of code selected can either be numeric or
- Line 60  my $resources_printed = '';
+ Line 108  my $resources_printed = '';
  #
  sub is_code_valid {
      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') {
+ 	$valid = &is_valid_numeric_code($code_value, $code_length);
+     } else {
+ 	$valid = &is_valid_alpha_code($code_value, $code_length);
+     }
-     return "Entering a single code is not supported (yet)";
+     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
- Line 2020  CHOOSE_STUDENTS
+ Line 2085  CHOOSE_STUDENTS
      <message><b>Value of CODE to print?</b></td><td></message>
      <string variable="SINGLE_CODE" size="10" defaultvalue="zzzz">
          <validator>
-            # Not sure of exact call context so...
- 	   use Apache::lonprintout;
  	   if(!\$helper->{'VARS'}{'NUMBER_TO_PRINT_TOTAL'}           &&
  	      !\$helper->{'VARS'}{'REUSE_OLD_CODES'}) {
  	      return &Apache::lonprintout::is_code_valid(\$helper->{'VARS'}{'SINGLE_CODE'},

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

Removed from v.1.382
changed lines
	Added in v.1.384