--- loncom/xml/lonxml.pm 2007/02/18 02:10:04 1.439 +++ loncom/xml/lonxml.pm 2007/09/11 23:53:13 1.459 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.439 2007/02/18 02:10:04 albertel Exp $ +# $Id: lonxml.pm,v 1.459 2007/09/11 23:53:13 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -42,6 +42,7 @@ package Apache::lonxml; use vars qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount); use strict; +use LONCAPA; use HTML::LCParser(); use HTML::TreeBuilder(); use HTML::Entities(); @@ -124,6 +125,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=''; @@ -315,13 +319,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 = (); @@ -356,6 +361,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"; } @@ -585,17 +595,23 @@ sub callsub { } elsif ($token->[0] eq 'E') { $currentstring = &Apache::edit::tag_end($target,$token); } - } elsif ($target eq 'modified') { + } + } + if ($target eq 'modified' && $nodefault eq '') { + if ($currentstring eq '') { + if ($token->[0] eq 'S') { + $currentstring = $token->[4]; + } elsif ($token->[0] eq 'E') { + $currentstring = $token->[2]; + } else { + $currentstring = $token->[2]; + } + } if ($token->[0] eq 'S') { - $currentstring = $token->[4]; - $currentstring.=&Apache::edit::handle_insert(); + $currentstring.=&Apache::edit::handle_insert(); } elsif ($token->[0] eq 'E') { - $currentstring = $token->[2]; - $currentstring.=&Apache::edit::handle_insertafter($token->[1]); - } else { - $currentstring = $token->[2]; + $currentstring.=&Apache::edit::handle_insertafter($token->[1]); } - } } } use strict 'refs'; @@ -613,6 +629,7 @@ sub setup_globals { &init_counter(); @Apache::lonxml::pwd=(); @Apache::lonxml::extlinks=(); + @script_var_displays=(); @Apache::lonxml::ssi_info=(); $Apache::lonxml::post_evaluate=1; $Apache::lonxml::warnings_error_header=''; @@ -783,6 +800,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'); @@ -891,6 +909,9 @@ sub endredirection { } pop @Apache::lonxml::outputstack; } +sub in_redirection { + return ($Apache::lonxml::redirection > 0) +} sub end_tag { my ($tagstack,$parstack,$token)=@_; @@ -951,8 +972,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; @@ -990,6 +1011,24 @@ sub get_all_text_unbalanced { return $result } +=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) + +=cut + sub increment_counter { my ($increment) = @_; if (defined($increment) && $increment gt 0) { @@ -1000,6 +1039,14 @@ sub increment_counter { $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; @@ -1202,7 +1249,7 @@ sub writeallows { my %httpref=(); foreach (@extlinks) { $httpref{'httpref.'. - &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; + &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl; } @extlinks=(); &Apache::lonnet::appenv(%httpref); @@ -1221,6 +1268,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 # @@ -1301,17 +1354,20 @@ SIMPLECONTENT sub inserteditinfo { - my ($result,$filecontents,$filetype)=@_; + my ($filecontents,$filetype)=@_; $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); # my $editheader='Edit below
'; my $xml_help = ''; my $initialize=''; - if ($filetype eq 'html') { - my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons(); - $initialize=&Apache::lonhtmlcommon::spellheader(); - if (!&Apache::lonhtmlcommon::htmlareablocked() && - &Apache::lonhtmlcommon::htmlareabrowser()) { - $initialize.=(< $addbuttons @@ -1321,21 +1377,34 @@ $addbuttons var editor=new HTMLArea("filecont",config); editor.registerPlugin(FullPage); editor.generate(); + setTimeout( + function () { + HTMLArea._addEvents(editor._doc, + ["keypress","mousedown"], unClean); + editor._iframe.id = '$textarea_id'; + resize_textarea('$textarea_id','LC_aftertextarea'); + },300); } FULLPAGE - } else { - $initialize.=(< $addbuttons function initDocument() { + resize_textarea('$textarea_id','LC_aftertextarea'); } FULLPAGE - } - $result=~s/\]*)\>/\/i; + } + + $add_to_onload = 'initDocument();'; + $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');"; + + if ($filetype eq 'html') { $xml_help=&Apache::loncommon::helpLatexCheatsheet(); } + my $cleanbut = ''; my $titledisplay=&display_title(); @@ -1347,29 +1416,31 @@ FULLPAGE my $buttons=(< -
+
BUTTONS $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont'); + my $textarea_events = &Apache::edit::element_change_detection(); + my $form_events = &Apache::edit::form_change_detection(); my $editfooter=(< -
+ $xml_help $buttons
- + +

$buttons
- $titledisplay +
+ ENDFOOTER -# $result=~s/(\]*\>)/$1$editheader/is; - $result=~s/(\<\/body\>)/$editfooter/is; - return $result; + return ($editfooter,$add_to_onload,$add_to_onresize);; } sub get_target { @@ -1465,38 +1536,64 @@ ENDNOTFOUND ['editmode']); } if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) { + &Apache::structuretags::reset_problem_globals(); $result = &Apache::lonxml::xmlparse($request,$target,$filecontents, '',%mystyle); - undef($Apache::lonhomework::parsing_a_task); + # .html files may contain or need to clean + # up if it did + &Apache::structuretags::reset_problem_globals(); + &Apache::lonhomework::finished_parsing(); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['rawmode']); if ($env{'form.rawmode'}) { $result = $filecontents; } + if ($filetype eq 'sty') { + my $controls = + ($env{'request.state'} eq 'construct') ? &Apache::londefdef::edit_controls() + : ''; + my %options = ('bgcolor' => '#FFFFFF'); + $result = + &Apache::loncommon::start_page(undef,undef,\%options). + $controls. + $result. + &Apache::loncommon::end_page(); + } } } - + # # Edit action? Insert editing commands # unless ($env{'request.state'} eq 'published') { if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'}))) - { + { + my ($edit_info, $add_to_onload, $add_to_onresize)= + &inserteditinfo($filecontents,$filetype); + my $displayfile=$request->uri; $displayfile=~s/^\/[^\/]*//; - my %options = (); + my %options = + ('add_entries' => + {'onresize' => $add_to_onresize, + 'onload' => $add_to_onload, }); + if ($env{'environment.remote'} ne 'off') { $options{'bgcolor'} = '#FFFFFF'; + $options{'only_body'} = 1; } - my $start_page = &Apache::loncommon::start_page(undef,undef, + my $js = + &Apache::edit::js_change_detection(). + &Apache::loncommon::resize_textarea_js(); + my $start_page = &Apache::loncommon::start_page(undef,$js, \%options); $result=$start_page. &Apache::lonxml::message_location().'

'. $displayfile. - '

'.&Apache::loncommon::end_page(); - $result=&inserteditinfo($result,$filecontents,$filetype); + ''. + $edit_info. + &Apache::loncommon::end_page(); } } if ($filetype eq 'html') { &writeallows($request->uri); } - &Apache::lonxml::add_messages(\$result); $request->print($result); @@ -1545,12 +1642,28 @@ sub show_error_warn_msg { } sub error { + my @errors = @_; + $errorcount++; + + if (defined($Apache::inputtags::part)) { + if ( @Apache::inputtags::response ) { + push(@errors, + &mt("This error occurred while processing response [_1] in part [_2]", + $Apache::inputtags::response[-1], + $Apache::inputtags::part)); + } else { + push(@errors, + &mt("This error occurred while processing part [_1]", + $Apache::inputtags::part)); + } + } + if ( &show_error_warn_msg() ) { # If printing in construction space, put the error inside

 	push(@Apache::lonxml::error_messages,
 	     $Apache::lonxml::warnings_error_header.
-	     "ERROR:".join("
\n",@_)."
\n"); + "ERROR:".join("
\n",@errors)."
\n"); $Apache::lonxml::warnings_error_header=''; } else { my $errormsg; @@ -1560,14 +1673,17 @@ sub error { $errormsg=&mt("An error occured while processing this resource. The author has been notified."); } my $host=$Apache::lonnet::perlvar{'lonHostID'}; - my $msg = join('
',(@_,"The error occurred on host $host")); + push(@errors, "The error occurred on host $host"); + + my $msg = join('
', @errors); + #notify author &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg); #notify course if ( $symb && $env{'request.course.id'} ) { my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; - my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1); + my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1); my $declutter=&Apache::lonnet::declutter($env{'request.filename'}); my $baseurl = &Apache::lonnet::clutter($declutter); my @userlist; @@ -1692,50 +1808,11 @@ sub get_param_var { } } -sub register_insert_tab { - my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab'); - my $i; - my $tagnum=0; - my @order; - for ($i=0;$i < $#data; $i++) { - my $line = $data[$i]; - if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; } - if ( $line =~ /TABLE/ ) { last; } - my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line); - if ($tag) { - $insertlist{"$tagnum.tag"} = $tag; - $insertlist{"$tag.description"} = $descrip; - $insertlist{"$tag.color"} = $color; - $insertlist{"$tag.function"} = $function; - if (!defined($show)) { $show='yes'; } - $insertlist{"$tag.show"}= $show; - $insertlist{"$tag.helpfile"} = $helpfile; - $insertlist{"$tag.helpdesc"} = $helpdesc; - $insertlist{"$tag.num"}=$tagnum; - $tagnum++; - } - } - $i++; #skipping TABLE line - $tagnum = 0; - for (;$i < $#data;$i++) { - my $line = $data[$i]; - my ($mnemonic,@which) = split(/ +/,$line); - my $tag = $insertlist{"$tagnum.tag"}; - for (my $j=0;$j <=$#which;$j++) { - if ( $which[$j] eq 'Y' ) { - if ($insertlist{"$j.show"} ne 'no') { - push(@{ $insertlist{"$tag.which"} },$insertlist{"$j.tag"}); - } - } - } - $tagnum++; - } -} - sub register_insert_xml { my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'} .'/insertlist.xml'); my ($tagnum,$in_help)=(0,0); + my @alltags; my $tag; while (my $token = $parser->get_token()) { if ($token->[0] eq 'S') { @@ -1744,6 +1821,7 @@ sub register_insert_xml { $tag = $token->[2]{'name'}; $insertlist{"$tagnum.tag"} = $tag; $insertlist{"$tag.num"} = $tagnum; + push(@alltags,$tag); } elsif ($in_help && $token->[1] eq 'file') { $key = $tag.'.helpfile'; } elsif ($in_help && $token->[1] eq 'description') { @@ -1757,11 +1835,7 @@ sub register_insert_xml { } elsif ($token->[1] eq 'help') { $in_help=1; } elsif ($token->[1] eq 'allow') { - my $allow = $parser->get_text(); - foreach my $element (split(',',$allow)) { - $element =~ s/(^\s*|\s*$ )//gx; - push(@{ $insertlist{$tag.'.which'} },$element); - } + $key = $tag.'.allow'; } if (defined($key)) { $insertlist{$key} = $parser->get_text(); @@ -1776,12 +1850,22 @@ sub register_insert_xml { } } } + + # parse the allows and ignore tags set to no + foreach my $tag (@alltags) { + next if (!exists($insertlist{"$tag.allow"})); + my $allow = $insertlist{"$tag.allow"}; + foreach my $element (split(',',$allow)) { + $element =~ s/(^\s*|\s*$ )//gx; + if (!exists($insertlist{"$element.show"}) + || $insertlist{"$element.show"} ne 'no') { + push(@{ $insertlist{$tag.'.which'} },$element); + } + } + } } sub register_insert { -# ®ister_insert_tab(@_); -# &dump_insertlist('1'); -# undef(%insertlist); return ®ister_insert_xml(@_); # &dump_insertlist('2'); }