--- loncom/interface/lonprintout.pm 2002/09/16 14:20:33 1.65 +++ loncom/interface/lonprintout.pm 2005/08/16 10:25:15 1.386 @@ -1,7 +1,7 @@ -# The LearningOnline Network +# The LearningOnline Network # Printout # -# $Id: lonprintout.pm,v 1.65 2002/09/16 14:20:33 sakharuk Exp $ +# $Id: lonprintout.pm,v 1.386 2005/08/16 10:25:15 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,17 +25,6 @@ # # http://www.lon-capa.org/ # -# (Internal Server Error Handler -# -# (Login Screen -# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, -# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) -# -# 3/1/1 Gerd Kortemeyer) -# -# 3/1 Gerd Kortemeyer -# -# 9/17 Alex Sakharuk # package Apache::lonprintout; @@ -48,964 +37,2696 @@ use Apache::inputtags; use Apache::grades; use Apache::edit; use Apache::File(); +use Apache::lonnavmaps; +use Apache::lonratedt; use POSIX qw(strftime); -use GDBM_File; +use Apache::lonlocal; +my $resources_printed = ''; -my %hash; - +# +# 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; +} -sub headerform { - my $r = shift; - $r->print(< - -LON-CAPA output for printing - - -
-ENDHEADER - if ($ENV{'request.role'}=~m/^cc\./ or $ENV{'request.role'}=~m/^in\./ or $ENV{'request.role'}=~m/^ta\./) { - $r->print(<Path to current document: $ENV{'form.postdata'}

-ENDHEADER1 +# 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)"; + } + 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. +# valid depends on the code type and the type of code selected. +# The type of code selected can either be numeric or +# Alphabetic. If alphabetic, the code, in fact is a simple +# substitution cipher for the actual numeric code: 0->A, 1->B ... +# We'll be nice and be case insensitive for alpha codes. +# Parameters: +# code_value - the value of the code the user typed in. +# code_option - The code type selected from the set in the scantron format +# table. +# Returns: +# undef - The code is valid. +# other - An error message indicating what's wrong. +# +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 () { + 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); + } + } +# Compare two students by name. The students are in the form +# returned by the helper: +# user:domain:section:last, first:status +# This is a helper function for the perl sort built-in therefore: +# Implicit Inputs: +# $a - The first element to compare (global) +# $b - The second element to compare (global) +# Returns: +# -1 - $a < $b +# 0 - $a == $b +# +1 - $a > $b +# Note that the initial comparison is done on the last names with the +# first names only used to break the tie. +# +# +sub compare_names { + # First split the names up into the primary fields. + + my ($u1, $d1, $s1, $n1, $stat1) = split(/:/, $a); + my ($u2, $d2, $s2, $n2, $stat2) = split(/:/, $b); -sub menu_for_output { - my $r = shift; - my ($title_for_single_resource,$title_for_sequence,$title_for_main_map) = &details_for_menu; - if ($title_for_single_resource ne '') {$title_for_single_resource = '"'.$title_for_single_resource.'"';} - if ($title_for_sequence ne '') {$title_for_sequence = '"'.$title_for_sequence.'"';} - if ($title_for_main_map ne '') {$title_for_main_map = '"'.$title_for_main_map.'"';} - my $subdir_to_print = $ENV{'form.postdata'}; - $subdir_to_print =~ m/\/([^\/]+)$/; - $subdir_to_print =~ s/$1//; - $r->print(<What do you want to print? Make a choice.
- - - Current document $title_for_single_resource -(prints what you just saw on the screen)
-ENDMENUOUT1 - if ((not $ENV{'request.role'}=~m/^au\./) and (not $ENV{'request.role'}=~m/^ca\./)) { - $r->print(< All problems from $title_for_sequence
- All problems plus any html/xml files from $title_for_sequence
-ENDMENUOUT2 - } - if ($ENV{'request.role'}=~m/^cc\./ or $ENV{'request.role'}=~m/^in\./ or $ENV{'request.role'}=~m/^ta\./) { - $r->print(< All problems in this course (warning: this may be time consuming)
-
- All problems from $title_for_sequence for selected students

-ENDMENUOUT6 + # Now split the last name and first name of each n: + # + + my ($l1,$f1) = split(/,/, $n1); + my ($l2,$f2) = split(/,/, $n2); + + # We don't bother to remove the leading/trailing whitespace from the + # firstname, unless the last names compare identical. + + if($l1 lt $l2) { + return -1; } - my $subdirtoprint = &Apache::lonnet::filelocation("",$ENV{'form.url'}); - $subdirtoprint =~ s/\/[^\/]+$//; - if (&Apache::lonnet::allowed('bre',$subdirtoprint) eq 'F') { - $r->print(< Problems from current subdirectory $subdir_to_print
-ENDMENUOUT4 - } - $r->print(<


-

And what page format do you prefer?

- - - - - - - -
- Landscape
- Portrait
- 		  - Number of columns: - - Paper size (format [width x height]): -
-
- -ENDMENUOUT5 + if($l1 gt $l2) { + return 1; + } + + # Break the tie on the first name, but there are leading (possibly trailing + # whitespaces to get rid of first + # + $f1 =~ s/^\s+//; # Remove leading... + $f1 =~ s/\s+$//; # Trailing spaces from first 1... + + $f2 =~ s/^\s+//; + $f2 =~ s/\s+$//; # And the same for first 2... + + if($f1 lt $f2) { + return -1; + } + if($f1 gt $f2) { + return 1; + } + + # Must be the same name. + + return 0; } +sub latex_header_footer_remove { + my $text = shift; + $text =~ s/\\end{document}//; + $text =~ s/\\documentclass([^&]*)\\begin{document}//; + return $text; +} -sub problem_choice_menu { - my $r = shift; - my $subdirtoprint = &Apache::lonnet::filelocation("",$ENV{'form.url'}); - $subdirtoprint =~ s/\/[^\/]+$//; - my @list_of_files = (); - if ($ENV{'request.role'}=~m/^au\./ or $ENV{'request.role'}=~m/^ca\./) { - $subdirtoprint =~ s/^[^~]*~(\w+)\//\/home\/$1\/public_html\//; - } else { - $subdirtoprint =~ s/.*(\/res\/)/$1/; - } - my @content_directory = (); - if ($ENV{'request.role'}=~m/^au\./ or $ENV{'request.role'}=~m/^ca\./) { - @content_directory = &Apache::lonnet::dirlist($subdirtoprint,$ENV{'user.domain'}, $ENV{'user.name'},''); - } else { - @content_directory = &Apache::lonnet::dirlist($subdirtoprint); - } - for (my $iy=0;$iy<=$#content_directory;$iy++) { - my @tempo_array = split(/&/,$content_directory[$iy]); - if ($tempo_array[0] =~ m/^[^\.]+\.(problem|exam|quiz|assess|survey|form|library)$/) { - push(@list_of_files,$tempo_array[0]); - } - } - $subdirtoprint =~ s/\/$//; - for (my $i=0;$i<=$#list_of_files;$i++) { - $list_of_files[$i] = $subdirtoprint.'/'.$list_of_files[$i]; - } - $r->print(< - - - -

Mark problems which you want to print

- -  - -

-ENDMENUOUT1 - my $i; - foreach my $file (@list_of_files) { - $r->print('
'. - $file); - $i++; + my $name_of_map = &Apache::lonnet::gettitle($env{'request.course.uri'}); + if ($name_of_map =~ /^\s*$/) { + $env{'request.course.uri'} =~ m|([^/]+)$|; + $name_of_map = $1; } - $r->print(< - - - -ENDMENUOUT2 + return ($name_of_resource,$name_of_sequence,$name_of_map); } -sub additional_class_menu { - my $r = shift; - $r->print(< - - - -

Mark students which assignments you want to print

-ENDMENUOUT1 - my %courselist=&Apache::lonnet::dump( - 'classlist', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - my $now=time; - $r->print(< - function checkall() { - for (i=0; i',$first_comment); + substr($result,$first_comment,$end_comment-$first_comment+3) = ''; + $first_comment = index($result,'',$first_comment); - substr($result,$first_comment,$end_comment-$first_comment+3) = ''; - $first_comment = index($result,'