--- loncom/xml/lonxml.pm 2006/12/11 00:42:47 1.430 +++ loncom/xml/lonxml.pm 2007/10/30 00:22:27 1.468 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.430 2006/12/11 00:42:47 albertel Exp $ +# $Id: lonxml.pm,v 1.468 2007/10/30 00:22:27 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(); @@ -88,10 +89,13 @@ use Apache::loncommon(); use Apache::lonfeedback(); use Apache::lonmsg(); 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 @@ -123,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=''; @@ -130,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; @@ -314,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 = (); @@ -355,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"; } @@ -549,7 +572,6 @@ sub callsub { } my $deleted=0; - $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); if (($token->[0] eq 'S') && ($target eq 'modified')) { $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack, $parstack,$parser,$safeeval, @@ -585,17 +607,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'; @@ -603,6 +631,24 @@ sub callsub { return $currentstring; } +{ + my %state; + + sub init_state { + undef(%state); + } + + sub set_state { + my ($key,$value) = @_; + $state{$key} = $value; + return $value; + } + sub get_state { + my ($key) = @_; + return $state{$key}; + } +} + sub setup_globals { my ($request,$target)=@_; $Apache::lonxml::request=$request; @@ -611,8 +657,11 @@ sub setup_globals { $Apache::lonxml::default_homework_loaded=0; $Apache::lonxml::usestyle=1; &init_counter(); + &clear_bubble_lines_for_part(); + &init_state(); @Apache::lonxml::pwd=(); @Apache::lonxml::extlinks=(); + @script_var_displays=(); @Apache::lonxml::ssi_info=(); $Apache::lonxml::post_evaluate=1; $Apache::lonxml::warnings_error_header=''; @@ -674,6 +723,14 @@ sub init_safespace { '&chem_standard_order'); $safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status'); + $safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval'); + $safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check'); + $safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval, + '&maxima_cas_formula_fix'); + + $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval, + '&capa_formula_fix'); + $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); @@ -775,6 +832,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'); @@ -883,6 +941,9 @@ sub endredirection { } pop @Apache::lonxml::outputstack; } +sub in_redirection { + return ($Apache::lonxml::redirection > 0) +} sub end_tag { my ($tagstack,$parstack,$token)=@_; @@ -893,59 +954,58 @@ sub end_tag { sub initdepth { @Apache::lonxml::depthcounter=(); - $Apache::lonxml::depth=-1; - $Apache::lonxml::olddepth=-1; + undef($Apache::lonxml::last_depth_count); } + my @timers; my $lasttime; +# @Apache::lonxml::depthcounter -> count of tags that exist so +# far at each level +# $Apache::lonxml::last_depth_count -> when ascending, need to +# remember the count for the level below the current level (for +# example going from 1_2 -> 1 -> 1_3 need to remember the 2 ) + sub increasedepth { my ($token) = @_; - $Apache::lonxml::depth++; - $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; - if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { - $Apache::lonxml::olddepth=$Apache::lonxml::depth; - } + push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1); + undef($Apache::lonxml::last_depth_count); my $time; if ($Apache::lonxml::debug eq "1") { push(@timers,[&gettimeofday()]); $time=&tv_interval($lasttime); $lasttime=[&gettimeofday()]; } - my $spacing=' 'x($Apache::lonxml::depth-1); - my $curdepth=join('_',@Apache::lonxml::depthcounter); - &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n"); + my $spacing=' 'x($#Apache::lonxml::depthcounter); + $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); +# &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time"); #print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; } sub decreasedepth { my ($token) = @_; - $Apache::lonxml::depth--; - if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { - $#Apache::lonxml::depthcounter--; - $Apache::lonxml::olddepth=$Apache::lonxml::depth+1; - } - if ( $Apache::lonxml::depth < -1) { - &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); - $Apache::lonxml::depth='-1'; + if ( $#Apache::lonxml::depthcounter == -1) { + &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); } + $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter); + my ($timer,$time); if ($Apache::lonxml::debug eq "1") { $timer=pop(@timers); $time=&tv_interval($lasttime); $lasttime=[&gettimeofday()]; } - my $spacing=' 'x$Apache::lonxml::depth; - my $curdepth=join('_',@Apache::lonxml::depthcounter); - &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n"); + my $spacing=' 'x($#Apache::lonxml::depthcounter); + $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter); +# &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer)); #print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; } 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; @@ -981,18 +1041,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_response - A concatenation of the part and response id + identifying exactly what is being 'answered'. + + +=cut + sub increment_counter { - my ($increment) = @_; - if (defined($increment) && $increment gt 0) { - $Apache::lonxml::counter+=$increment; - } else { - $Apache::lonxml::counter++; + my ($increment, $part_response) = @_; + if (!defined($increment) || $increment le 0) { + $increment = 1; + } + $Apache::lonxml::counter += $increment; + + # If the caller supplied the response_id parameter, + # Maintain its counter.. creating if necessary. + + if(defined($part_response)) { + if (!defined($Apache::lonxml::counters_per_part{$part_response})) { + $Apache::lonxml::counters_per_part{$part_response} = 0; + } + $Apache::lonxml::counters_per_part{$part_response} += $increment; + my $new_value = $Apache::lonxml::counters_per_part{$part_response}; } + $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; @@ -1038,6 +1146,74 @@ sub store_counter { } } +=pod + +=item bubble_lines_for_part(part_response) + +Returns the number of lines required to get a response for +$part_response (this is just $Apache::lonxml::counters_per_part{$part_response} + +=cut + +sub bubble_lines_for_part { + my ($part_response) = @_; + + if (!defined($Apache::lonxml::counters_per_part{$part_response})) { + return 0; + } else { + return $Apache::lonxml::counters_per_part{$part_response}; + } + +} + +=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_response, 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_response, $value) = @_; + + $Apache::lonxml::counters_per_part{$part_response} = $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; @@ -1195,7 +1371,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); @@ -1214,6 +1390,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 # @@ -1294,41 +1476,58 @@ 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 - - HTMLArea.loadPlugin("FullPage"); - +lonca function initDocument() { - var editor=new HTMLArea("filecont",config); - editor.registerPlugin(FullPage); - editor.generate(); + var oFCKeditor = new FCKeditor('filecont'); + oFCKeditor.Config['CustomConfigurationsPath'] = '/fckeditor/loncapaconfig.js' ; + oFCKeditor.Config['FullPage'] = true + oFCKeditor.Config['AutoDetectLanguage'] = false; + oFCKeditor.Config['DefaultLanguage'] = "$lang"; + oFCKeditor.ReplaceTextarea(); + } + function check_if_dirty(editor) { + if (editor.IsDirty()) { + unClean(); + } + } + function FCKeditor_OnComplete(editor) { + editor.Events.AttachEvent("OnSelectionChange",check_if_dirty); + resize_textarea('$textarea_id','LC_aftertextarea'); } 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(); @@ -1340,29 +1539,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 { @@ -1457,40 +1658,65 @@ ENDNOTFOUND &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['editmode']); } - &Apache::lonnet::logthis("edit mode is ".$env{'form.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); @@ -1539,12 +1765,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; @@ -1554,15 +1796,19 @@ 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; foreach (keys %users) { my ($user,$domain) = split(/:/, $_); @@ -1573,8 +1819,11 @@ sub error { $cdom,$cnum); my $now=time; if ($now-$lastnotified{$key}>86400) { + my $title = &Apache::lonnet::gettitle($symb); + my $sentmessage; &Apache::lonmsg::user_normal_msg($user,$domain, - "Error [$declutter]",$msg); + "Error [$title]",$msg,'',$baseurl,'','', + \$sentmessage,$symb,$title,1); &Apache::lonnet::put('nohist_xmlerrornotifications', {$key => $now}, $cdom,$cnum); @@ -1682,71 +1931,144 @@ sub get_param_var { } } -sub register_insert { - 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{"$tagnum.description"} = $descrip; - $insertlist{"$tagnum.color"} = $color; - $insertlist{"$tagnum.function"} = $function; - if (!defined($show)) { $show='yes'; } - $insertlist{"$tagnum.show"}= $show; - $insertlist{"$tagnum.helpfile"} = $helpfile; - $insertlist{"$tagnum.helpdesc"} = $helpdesc; - $insertlist{"$tag.num"}=$tagnum; - $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') { + my $key; + if ($token->[1] eq 'tag') { + $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') { + $key = $tag.'.helpdesc'; + } elsif ($token->[1] eq 'description' || + $token->[1] eq 'color' || + $token->[1] eq 'show' ) { + $key = $tag.'.'.$token->[1]; + } elsif ($token->[1] eq 'insert_sub') { + $key = $tag.'.function'; + } elsif ($token->[1] eq 'help') { + $in_help=1; + } elsif ($token->[1] eq 'allow') { + $key = $tag.'.allow'; + } + if (defined($key)) { + $insertlist{$key} = $parser->get_text(); + $insertlist{$key} =~ s/(^\s*|\s*$ )//gx; + } + } elsif ($token->[0] eq 'E') { + if ($token->[1] eq 'tag') { + undef($tag); + $tagnum++; + } elsif ($token->[1] eq 'help') { + undef($in_help); + } + } } - } - $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"} },$j); + + # 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); + } } - } } - $tagnum++; - } +} + +sub register_insert { + return ®ister_insert_xml(@_); +# &dump_insertlist('2'); +} + +sub dump_insertlist { + my ($ext) = @_; + open(XML,">/tmp/insertlist.xml.$ext"); + print XML (""); + my $i=0; + + while (exists($insertlist{"$i.tag"})) { + my $tag = $insertlist{"$i.tag"}; + print XML (" +\t"); + if (defined($insertlist{"$tag.description"})) { + print XML (" +\t\t".$insertlist{"$tag.description"}.""); + } + if (defined($insertlist{"$tag.color"})) { + print XML (" +\t\t".$insertlist{"$tag.color"}.""); + } + if (defined($insertlist{"$tag.function"})) { + print XML (" +\t\t".$insertlist{"$tag.function"}.""); + } + if (defined($insertlist{"$tag.show"}) + && $insertlist{"$tag.show"} ne 'yes') { + print XML (" +\t\t".$insertlist{"$tag.show"}.""); + } + if (defined($insertlist{"$tag.helpfile"})) { + print XML (" +\t\t +\t\t\t".$insertlist{"$tag.helpfile"}.""); + if ($insertlist{"$tag.helpdesc"} ne '') { + print XML (" +\t\t\t".$insertlist{"$tag.helpdesc"}.""); + } + print XML (" +\t\t"); + } + if (defined($insertlist{"$tag.which"})) { + print XML (" +\t\t".join(',',sort(@{ $insertlist{"$tag.which"} })).""); + } + print XML (" +\t"); + $i++; + } + print XML ("\n\n"); + close(XML); } sub description { - my ($token)=@_; - my $tagnum; - my $tag=$token->[1]; - foreach my $namespace (reverse @Apache::lonxml::namespace) { - my $testtag=$namespace.'::'.$tag; - $tagnum=$insertlist{"$testtag.num"}; - if (defined($tagnum)) { last; } - } - if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } - return $insertlist{$tagnum.'.description'}; + my ($token)=@_; + my $tag = &get_tag($token); + return $insertlist{$tag.'.description'}; } # Returns a list containing the help file, and the description sub helpinfo { - my ($token)=@_; - my $tagnum; - my $tag=$token->[1]; - foreach my $namespace (reverse @Apache::lonxml::namespace) { - my $testtag=$namespace.'::'.$tag; - $tagnum=$insertlist{"$testtag.num"}; - if (defined($tagnum)) { last; } - } - if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } - return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'}); + my ($token)=@_; + my $tag = &get_tag($token); + return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'}); +} + +sub get_tag { + my ($token)=@_; + my $tagnum; + my $tag=$token->[1]; + foreach my $namespace (reverse(@Apache::lonxml::namespace)) { + my $testtag = $namespace.'::'.$tag; + $tagnum = $insertlist{"$testtag.num"}; + last if (defined($tagnum)); + } + if (!defined($tagnum)) { + $tagnum = $Apache::lonxml::insertlist{"$tag.num"}; + } + return $insertlist{"$tagnum.tag"}; } 1;