--- loncom/xml/lonxml.pm 2007/04/16 18:47:46 1.444 +++ loncom/xml/lonxml.pm 2007/10/10 00:02:27 1.463 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.444 2007/04/16 18:47:46 albertel Exp $ +# $Id: lonxml.pm,v 1.463 2007/10/10 00:02:27 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -92,8 +92,10 @@ use Apache::loncacc(); use Apache::lonmaxima(); use Apache::lonlocal; -#================================================== Main subroutine: xmlparse +#==================================== Main subroutine: xmlparse + #debugging control, to turn on debugging modify the correct handler + $Apache::lonxml::debug=0; # keeps count of the number of warnings and errors generated in a parse @@ -125,6 +127,9 @@ $evaluate = 1; # stores the list of active tag namespaces @namespace=(); +# stores all Scrit Vars displays for later showing +my @script_var_displays=(); + # a pointer the the Apache request object $Apache::lonxml::request=''; @@ -132,6 +137,16 @@ $Apache::lonxml::request=''; $Apache::lonxml::counter=1; $Apache::lonxml::counter_changed=0; +# Part counter hash. In analysis mode, the +# problems can use this to record which parts increment the counter +# by how much. The counter subs will maintain this hash via +# their optional part parameters. Note that the assumption is that +# analysis is done in one request and therefore it is not necessary to +# save this information request-to-request. + + +%Apache::lonxml::counters_per_part = (); + #internal check on whether to look at style defs $Apache::lonxml::usestyle=1; @@ -316,13 +331,14 @@ sub xmlparse { } } } - } elsif ($env{'construct.style'} && ($env{'request.state'} eq 'construct')) { + } elsif ($env{'construct.style'} + && ($env{'request.state'} eq 'construct')) { my $location=&Apache::lonnet::filelocation('',$env{'construct.style'}); my $styletext=&Apache::lonnet::getfile($location); - if ($styletext ne '-1') { - %style_for_target = (%style_for_target, - &Apache::style::styleparser($target,$styletext)); - } + if ($styletext ne '-1') { + %style_for_target = (%style_for_target, + &Apache::style::styleparser($target,$styletext)); + } } #&printalltags(); my @pars = (); @@ -357,6 +373,11 @@ sub xmlparse { &clean_safespace($safeeval); + if (@script_var_displays) { + $finaloutput .= join('',@script_var_displays); + undef(@script_var_displays); + } + if ($env{'form.return_only_error_and_warning_counts'}) { return "$errorcount:$warningcount"; } @@ -599,9 +620,9 @@ sub callsub { } } if ($token->[0] eq 'S') { - $currentstring.=&Apache::edit::handle_insert(); + $currentstring.=&Apache::edit::handle_insert(); } elsif ($token->[0] eq 'E') { - $currentstring.=&Apache::edit::handle_insertafter($token->[1]); + $currentstring.=&Apache::edit::handle_insertafter($token->[1]); } } } @@ -618,8 +639,10 @@ sub setup_globals { $Apache::lonxml::default_homework_loaded=0; $Apache::lonxml::usestyle=1; &init_counter(); + &clear_bubble_lines_for_part(); @Apache::lonxml::pwd=(); @Apache::lonxml::extlinks=(); + @script_var_displays=(); @Apache::lonxml::ssi_info=(); $Apache::lonxml::post_evaluate=1; $Apache::lonxml::warnings_error_header=''; @@ -790,6 +813,7 @@ sub init_safespace { $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); + $safehole->wrap(\&Apache::loncommon::languages,$safeeval,'&languages'); $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR'); $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG'); $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS'); @@ -898,6 +922,9 @@ sub endredirection { } pop @Apache::lonxml::outputstack; } +sub in_redirection { + return ($Apache::lonxml::redirection > 0) +} sub end_tag { my ($tagstack,$parstack,$token)=@_; @@ -958,8 +985,8 @@ sub decreasedepth { sub get_id { my ($parstack,$safeeval)=@_; my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval); - if ($env{'request.state'} eq 'construct' && $id =~ /(\.|_)/) { - &error(&mt("IDs are not allowed to contain "_" or "."")); + if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\d\s[:punct:]])/) { + &error(&mt("ID "[_1]" contains invalid characters, IDs are only allowed to contain letters, numbers, spaces and -",''.$id.'')); } if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; } return $id; @@ -995,18 +1022,66 @@ sub get_all_text_unbalanced { } } return $result + } +######################################################################### +# # +# bubble line counter management # +# # +######################################################################### + +=pod + +For bubble grading mode and exam bubble printing mode, the tracking of +the current 'bubble line number' is stored in the %env element +'form.counter', and is modifed and handled by the following routines. + +The value of it is stored in $Apache:lonxml::counter when live and +stored back to env after done. + +=item &increment_counter($increment); + +Increments the internal counter environment variable a specified amount + +Optional Arguments: + $increment - amount to increment by (defaults to 1) + Also 1 if the value is negative or zero. + $part_id - optional part id.. during analysis, this + indicates whic part of a problem is being + counted. + +=cut + sub increment_counter { - my ($increment) = @_; - if (defined($increment) && $increment gt 0) { - $Apache::lonxml::counter+=$increment; - } else { - $Apache::lonxml::counter++; + my ($increment, $part_id) = @_; + if (!defined($increment) || $increment le 0) { + $increment = 1; + } + $Apache::lonxml::counter += $increment; + + # If the caller supplied the part_id parameter, + # Maintain its counter.. creating if necessary. + + if(defined($part_id)) { + if (!defined($Apache::lonxml::counters_per_part{$part_id})) { + $Apache::lonxml::counters_per_part{$part_id} = 0; + } + $Apache::lonxml::counters_per_part{$part_id} += $increment; + my $new_value = $Apache::lonxml::counters_per_part{$part_id}; } + $Apache::lonxml::counter_changed=1; } +=pod + +=item &init_counter($increment); + +Initialize the internal counter environment variable + +=cut + sub init_counter { if ($env{'request.state'} eq 'construct') { $Apache::lonxml::counter=1; @@ -1052,6 +1127,74 @@ sub store_counter { } } +=pod + +=item bubble_lines_for_part(part_id) + +Returns the number of lines required to get a response for +$part_id (this is just $Apache::lonxml::counters_per_part{$part_id} + +=cut + +sub bubble_lines_for_part { + my ($part_id) = @_; + + if (!defined($Apache::lonxml::counters_per_part{$part_id})) { + return 0; + } else { + return $Apache::lonxml::counters_per_part{$part_id}; + } + +} + +=pod + +=item clear_bubble_lines_for_part + +Clears the hash of bubble lines per part. If a caller +needs to analyze several resources this should be called between +resources to reset the hash for each problem being analyzed. + +=cut + +sub clear_bubble_lines_for_part { + undef(%Apache::lonxml::counters_per_part); +} + +=pod + +=item set_bubble_lines(part_id, value) + +If there is a problem part, that for whatever reason +requires bubble lines that are not +the same as the counter increment, it can call this sub during +analysis to set its hash value explicitly. + +=cut + +sub set_bubble_lines { + my ($part_id, $value) = @_; + + $Apache::lonxml::counters_per_part{$part_id} = $value; +} + +=pod + +=item get_bubble_line_hash + +Returns the current bubble line hash. This is assumed to +be small so we return a copy + + +=cut + +sub get_bubble_line_hash { + return %Apache::lonxml::counters_per_part; +} + + +#-------------------------------------------------- + sub get_all_text { my($tag,$pars,$style)= @_; my $gotfullstack=1; @@ -1228,6 +1371,12 @@ sub do_registered_ssi { &Apache::lonnet::ssi($url,%form); } } + +sub add_script_result { + my ($display) = @_; + push(@script_var_displays, $display); +} + # # Afterburner handles anchors, highlights and links # @@ -1308,41 +1457,59 @@ SIMPLECONTENT sub inserteditinfo { - my ($result,$filecontents,$filetype)=@_; + my ($filecontents,$filetype)=@_; $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); # my $editheader='Edit below