loncom/xml/lonxml.pm - diff

Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.429 and 1.451

version 1.429, 2006/11/30 08:53:35	version 1.451, 2007/08/17 21:24:21
Line 42 package Apache::lonxml;	Line 42 package Apache::lonxml;
use vars	use vars
qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);	qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
use strict;	use strict;
	use LONCAPA;
use HTML::LCParser();	use HTML::LCParser();
use HTML::TreeBuilder();	use HTML::TreeBuilder();
use HTML::Entities();	use HTML::Entities();
Line 88 use Apache::loncommon();	Line 89 use Apache::loncommon();
use Apache::lonfeedback();	use Apache::lonfeedback();
use Apache::lonmsg();	use Apache::lonmsg();
use Apache::loncacc();	use Apache::loncacc();
	use Apache::lonmaxima();
use Apache::lonlocal;	use Apache::lonlocal;

#================================================== Main subroutine: xmlparse	#================================================== Main subroutine: xmlparse
Line 123 $evaluate = 1;	Line 125 $evaluate = 1;
# stores the list of active tag namespaces	# stores the list of active tag namespaces
@namespace=();	@namespace=();

	# stores all Scrit Vars displays for later showing
	my @script_var_displays=();

# a pointer the the Apache request object	# a pointer the the Apache request object
$Apache::lonxml::request='';	$Apache::lonxml::request='';

Line 314 sub xmlparse {	Line 319 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 $location=&Apache::lonnet::filelocation('',$env{'construct.style'});
my $styletext=&Apache::lonnet::getfile($location);	my $styletext=&Apache::lonnet::getfile($location);
if ($styletext ne '-1') {	if ($styletext ne '-1') {
%style_for_target = (%style_for_target,	%style_for_target = (%style_for_target,
&Apache::style::styleparser($target,$styletext));	&Apache::style::styleparser($target,$styletext));
}	}
}	}
#&printalltags();	#&printalltags();
my @pars = ();	my @pars = ();
Line 355 sub xmlparse {	Line 361 sub xmlparse {

&clean_safespace($safeeval);	&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'}) {	if ($env{'form.return_only_error_and_warning_counts'}) {
return "$errorcount:$warningcount";	return "$errorcount:$warningcount";
}	}
Line 549 sub callsub {	Line 560 sub callsub {
}	}

my $deleted=0;	my $deleted=0;
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
if (($token->[0] eq 'S') && ($target eq 'modified')) {	if (($token->[0] eq 'S') && ($target eq 'modified')) {
$deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,	$deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
$parstack,$parser,$safeeval,	$parstack,$parser,$safeeval,
Line 585 sub callsub {	Line 595 sub callsub {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$currentstring = &Apache::edit::tag_end($target,$token);	$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') {	if ($token->[0] eq 'S') {
$currentstring = $token->[4];	$currentstring.=&Apache::edit::handle_insert();
$currentstring.=&Apache::edit::handle_insert();
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$currentstring = $token->[2];	$currentstring.=&Apache::edit::handle_insertafter($token->[1]);
$currentstring.=&Apache::edit::handle_insertafter($token->[1]);
} else {
$currentstring = $token->[2];
}	}
}
}	}
}	}
use strict 'refs';	use strict 'refs';
Line 613 sub setup_globals {	Line 629 sub setup_globals {
&init_counter();	&init_counter();
@Apache::lonxml::pwd=();	@Apache::lonxml::pwd=();
@Apache::lonxml::extlinks=();	@Apache::lonxml::extlinks=();
	@script_var_displays=();
@Apache::lonxml::ssi_info=();	@Apache::lonxml::ssi_info=();
$Apache::lonxml::post_evaluate=1;	$Apache::lonxml::post_evaluate=1;
$Apache::lonxml::warnings_error_header='';	$Apache::lonxml::warnings_error_header='';
Line 674 sub init_safespace {	Line 691 sub init_safespace {
'&chem_standard_order');	'&chem_standard_order');
$safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status');	$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::asin,$safeeval,'&asin');
$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');	$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');	$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
Line 780 sub init_safespace {	Line 805 sub init_safespace {
$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');	$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
$safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');	$safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');
$safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');	$safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');
use Data::Dumper;	# use Data::Dumper;
$safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper');	# $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper');
#need to inspect this class of ops	#need to inspect this class of ops
# $safeeval->deny(":base_orig");	# $safeeval->deny(":base_orig");
$safeeval->permit("require");	$safeeval->permit("require");
Line 893 sub end_tag {	Line 918 sub end_tag {

sub initdepth {	sub initdepth {
@Apache::lonxml::depthcounter=();	@Apache::lonxml::depthcounter=();
$Apache::lonxml::depth=-1;	undef($Apache::lonxml::last_depth_count);
$Apache::lonxml::olddepth=-1;
}	}


my @timers;	my @timers;
my $lasttime;	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 {	sub increasedepth {
my ($token) = @_;	my ($token) = @_;
$Apache::lonxml::depth++;	push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1);
$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;	undef($Apache::lonxml::last_depth_count);
if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
$Apache::lonxml::olddepth=$Apache::lonxml::depth;
}
my $time;	my $time;
if ($Apache::lonxml::debug eq "1") {	if ($Apache::lonxml::debug eq "1") {
push(@timers,[&gettimeofday()]);	push(@timers,[&gettimeofday()]);
$time=&tv_interval($lasttime);	$time=&tv_interval($lasttime);
$lasttime=[&gettimeofday()];	$lasttime=[&gettimeofday()];
}	}
my $spacing=' 'x($Apache::lonxml::depth-1);	my $spacing=' 'x($#Apache::lonxml::depthcounter);
my $curdepth=join('_',@Apache::lonxml::depthcounter);	$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n");	# &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time");
#print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";	#print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
}	}

sub decreasedepth {	sub decreasedepth {
my ($token) = @_;	my ($token) = @_;
$Apache::lonxml::depth--;	if ( $#Apache::lonxml::depthcounter == -1) {
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {	&Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
$#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';
}	}
	$Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter);

my ($timer,$time);	my ($timer,$time);
if ($Apache::lonxml::debug eq "1") {	if ($Apache::lonxml::debug eq "1") {
$timer=pop(@timers);	$timer=pop(@timers);
$time=&tv_interval($lasttime);	$time=&tv_interval($lasttime);
$lasttime=[&gettimeofday()];	$lasttime=[&gettimeofday()];
}	}
my $spacing=' 'x$Apache::lonxml::depth;	my $spacing=' 'x($#Apache::lonxml::depthcounter);
my $curdepth=join('_',@Apache::lonxml::depthcounter);	$Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n");	# &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer));
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";	#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}	}

sub get_id {	sub get_id {
my ($parstack,$safeeval)=@_;	my ($parstack,$safeeval)=@_;
my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);	my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
if ($env{'request.state'} eq 'construct' && $id =~ /(\.\|_)/) {	if ($env{'request.state'} eq 'construct' && $id =~ /([._]\|[^\w\d\s[:punct:]])/) {
&error(&mt("IDs are not allowed to contain "<tt>_</tt>" or "<tt>.</tt>""));	&error(&mt("ID "[_1]" contains invalid characters, IDs are only allowed to contain letters, numbers, spaces and -",'<tt>'.$id.'</tt>'));
}	}
if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }	if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
return $id;	return $id;
Line 983 sub get_all_text_unbalanced {	Line 1007 sub get_all_text_unbalanced {
return $result	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 {	sub increment_counter {
my ($increment) = @_;	my ($increment) = @_;
if (defined($increment) && $increment gt 0) {	if (defined($increment) && $increment gt 0) {
Line 993 sub increment_counter {	Line 1035 sub increment_counter {
$Apache::lonxml::counter_changed=1;	$Apache::lonxml::counter_changed=1;
}	}

	=pod

	=item &init_counter($increment);

	Initialize the internal counter environment variable

	=cut

sub init_counter {	sub init_counter {
if ($env{'request.state'} eq 'construct') {	if ($env{'request.state'} eq 'construct') {
$Apache::lonxml::counter=1;	$Apache::lonxml::counter=1;
Line 1195 sub writeallows {	Line 1245 sub writeallows {
my %httpref=();	my %httpref=();
foreach (@extlinks) {	foreach (@extlinks) {
$httpref{'httpref.'.	$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;	&Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
}	}
@extlinks=();	@extlinks=();
&Apache::lonnet::appenv(%httpref);	&Apache::lonnet::appenv(%httpref);
Line 1214 sub do_registered_ssi {	Line 1264 sub do_registered_ssi {
&Apache::lonnet::ssi($url,%form);	&Apache::lonnet::ssi($url,%form);
}	}
}	}

	sub add_script_result {
	my ($display) = @_;
	push(@script_var_displays, $display);
	}

#	#
# Afterburner handles anchors, highlights and links	# Afterburner handles anchors, highlights and links
#	#
Line 1294 SIMPLECONTENT	Line 1350 SIMPLECONTENT


sub inserteditinfo {	sub inserteditinfo {
my ($result,$filecontents,$filetype)=@_;	my ($filecontents,$filetype)=@_;
$filecontents = &HTML::Entities::encode($filecontents,'<>&"');	$filecontents = &HTML::Entities::encode($filecontents,'<>&"');
# my $editheader='<a href="#editsection">Edit below</a><hr />';	# my $editheader='<a href="#editsection">Edit below</a><hr />';
my $xml_help = '';	my $xml_help = '';
my $initialize='';	my $initialize='';
	my $add_to_onload;
if ($filetype eq 'html') {	if ($filetype eq 'html') {
my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();	my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
$initialize=&Apache::lonhtmlcommon::spellheader();	$initialize=&Apache::lonhtmlcommon::spellheader();
Line 1314 $addbuttons	Line 1371 $addbuttons
var editor=new HTMLArea("filecont",config);	var editor=new HTMLArea("filecont",config);
editor.registerPlugin(FullPage);	editor.registerPlugin(FullPage);
editor.generate();	editor.generate();
	setTimeout(
	function () {
	HTMLArea._addEvents(editor._doc,
	["keypress","mousedown"], unClean);
	},300);
}	}
</script>	</script>
FULLPAGE	FULLPAGE
Line 1326 $addbuttons	Line 1388 $addbuttons
</script>	</script>
FULLPAGE	FULLPAGE
}	}
$result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;	$add_to_onload = 'initDocument();';
$xml_help=&Apache::loncommon::helpLatexCheatsheet();	$xml_help=&Apache::loncommon::helpLatexCheatsheet();
}	}
my $cleanbut = '';	my $cleanbut = '';
Line 1345 $cleanbut	Line 1407 $cleanbut
<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />	<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
BUTTONS	BUTTONS
$buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');	$buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
	my $textarea_events = &Apache::edit::element_change_detection();
	my $form_events = &Apache::edit::form_change_detection();
my $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
$initialize	$initialize
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post" name="xmledit">	<form $form_events method="post" name="xmledit">
$xml_help	$xml_help
<input type="hidden" name="editmode" value="$lt{'ed'}" />	<input type="hidden" name="editmode" value="$lt{'ed'}" />
$buttons<br />	$buttons<br />
<textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>	<textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
<br />$buttons	<br />$buttons
<br />	<br />
</form>	</form>
$titledisplay	$titledisplay
</body>	</body>
ENDFOOTER	ENDFOOTER
# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;	return ($editfooter,$add_to_onload);;
$result=~s/(\<\/body\>)/$editfooter/is;
return $result;
}	}

sub get_target {	sub get_target {
Line 1457 ENDNOTFOUND	Line 1519 ENDNOTFOUND
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['editmode']);	['editmode']);
}	}
&Apache::lonnet::logthis("edit mode is ".$env{'form.editmode'});
if (!$env{'form.editmode'} \|\| $env{'form.viewmode'} \|\| $env{'form.discardview'}) {	if (!$env{'form.editmode'} \|\| $env{'form.viewmode'} \|\| $env{'form.discardview'}) {
$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,	$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
'',%mystyle);	'',%mystyle);
Line 1473 ENDNOTFOUND	Line 1534 ENDNOTFOUND
#	#
unless ($env{'request.state'} eq 'published') {	unless ($env{'request.state'} eq 'published') {
if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))	if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
{	{
	my ($edit_info, $add_to_onload)=
	&inserteditinfo($filecontents,$filetype);

my $displayfile=$request->uri;	my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;	$displayfile=~s/^\/[^\/]*//;
my %options = ();	my %options =
	('add_entries' =>
	{'onload' => $add_to_onload, });
if ($env{'environment.remote'} ne 'off') {	if ($env{'environment.remote'} ne 'off') {
$options{'bgcolor'} = '#FFFFFF';	$options{'bgcolor'} = '#FFFFFF';
	$options{'only_body'} = 1;
}	}
my $start_page = &Apache::loncommon::start_page(undef,undef,	my $js = &Apache::edit::js_change_detection();
	my $start_page = &Apache::loncommon::start_page(undef,$js,
\%options);	\%options);
$result=$start_page.	$result=$start_page.
&Apache::lonxml::message_location().'<h3>'.	&Apache::lonxml::message_location().'<h3>'.
$displayfile.	$displayfile.
'</h3>'.&Apache::loncommon::end_page();	'</h3>'.
$result=&inserteditinfo($result,$filecontents,$filetype);	$edit_info.
	&Apache::loncommon::end_page();
}	}
}	}
if ($filetype eq 'html') { &writeallows($request->uri); }	if ($filetype eq 'html') { &writeallows($request->uri); }


&Apache::lonxml::add_messages(\$result);	&Apache::lonxml::add_messages(\$result);
$request->print($result);	$request->print($result);
Line 1561 sub error {	Line 1629 sub error {
if ( $symb && $env{'request.course.id'} ) {	if ( $symb && $env{'request.course.id'} ) {
my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};	my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};	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 $declutter=&Apache::lonnet::declutter($env{'request.filename'});
	my $baseurl = &Apache::lonnet::clutter($declutter);
my @userlist;	my @userlist;
foreach (keys %users) {	foreach (keys %users) {
my ($user,$domain) = split(/:/, $_);	my ($user,$domain) = split(/:/, $_);
Line 1573 sub error {	Line 1642 sub error {
$cdom,$cnum);	$cdom,$cnum);
my $now=time;	my $now=time;
if ($now-$lastnotified{$key}>86400) {	if ($now-$lastnotified{$key}>86400) {
	my $title = &Apache::lonnet::gettitle($symb);
	my $sentmessage;
&Apache::lonmsg::user_normal_msg($user,$domain,	&Apache::lonmsg::user_normal_msg($user,$domain,
"Error [$declutter]",$msg);	"Error [$title]",$msg,'',$baseurl,'','',
	\$sentmessage,$symb,$title,1);
&Apache::lonnet::put('nohist_xmlerrornotifications',	&Apache::lonnet::put('nohist_xmlerrornotifications',
{$key => $now},	{$key => $now},
$cdom,$cnum);	$cdom,$cnum);
Line 1682 sub get_param_var {	Line 1754 sub get_param_var {
}	}
}	}

sub register_insert {	sub register_insert_xml {
my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');	my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
my $i;	.'/insertlist.xml');
my $tagnum=0;	my ($tagnum,$in_help)=(0,0);
my @order;	my @alltags;
for ($i=0;$i < $#data; $i++) {	my $tag;
my $line = $data[$i];	while (my $token = $parser->get_token()) {
if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }	if ($token->[0] eq 'S') {
if ( $line =~ /TABLE/ ) { last; }	my $key;
my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);	if ($token->[1] eq 'tag') {
if ($tag) {	$tag = $token->[2]{'name'};
$insertlist{"$tagnum.tag"} = $tag;	$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tagnum.description"} = $descrip;	$insertlist{"$tag.num"} = $tagnum;
$insertlist{"$tagnum.color"} = $color;	push(@alltags,$tag);
$insertlist{"$tagnum.function"} = $function;	} elsif ($in_help && $token->[1] eq 'file') {
if (!defined($show)) { $show='yes'; }	$key = $tag.'.helpfile';
$insertlist{"$tagnum.show"}= $show;	} elsif ($in_help && $token->[1] eq 'description') {
$insertlist{"$tagnum.helpfile"} = $helpfile;	$key = $tag.'.helpdesc';
$insertlist{"$tagnum.helpdesc"} = $helpdesc;	} elsif ($token->[1] eq 'description' \|\|
$insertlist{"$tag.num"}=$tagnum;	$token->[1] eq 'color' \|\|
$tagnum++;	$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	# parse the allows and ignore tags set to <show>no</show>
$tagnum = 0;	foreach my $tag (@alltags) {
for (;$i < $#data;$i++) {	next if (!exists($insertlist{"$tag.allow"}));
my $line = $data[$i];	my $allow = $insertlist{"$tag.allow"};
my ($mnemonic,@which) = split(/ +/,$line);	foreach my $element (split(',',$allow)) {
my $tag = $insertlist{"$tagnum.tag"};	$element =~ s/(^\s\|\s$ )//gx;
for (my $j=0;$j <=$#which;$j++) {	if (!exists($insertlist{"$element.show"})
if ( $which[$j] eq 'Y' ) {	\|\| $insertlist{"$element.show"} ne 'no') {
if ($insertlist{"$j.show"} ne 'no') {	push(@{ $insertlist{$tag.'.which'} },$element);
push(@{ $insertlist{"$tag.which"} },$j);	}
}	}
}
}	}
$tagnum++;	}
}
	sub register_insert {
	return &register_insert_xml(@_);
	# &dump_insertlist('2');
	}

	sub dump_insertlist {
	my ($ext) = @_;
	open(XML,">/tmp/insertlist.xml.$ext");
	print XML ("<insertlist>");
	my $i=0;

	while (exists($insertlist{"$i.tag"})) {
	my $tag = $insertlist{"$i.tag"};
	print XML ("
	\t<tag name=\"$tag\">");
	if (defined($insertlist{"$tag.description"})) {
	print XML ("
	\t\t<description>".$insertlist{"$tag.description"}."</description>");
	}
	if (defined($insertlist{"$tag.color"})) {
	print XML ("
	\t\t<color>".$insertlist{"$tag.color"}."</color>");
	}
	if (defined($insertlist{"$tag.function"})) {
	print XML ("
	\t\t<insert_sub>".$insertlist{"$tag.function"}."</insert_sub>");
	}
	if (defined($insertlist{"$tag.show"})
	&& $insertlist{"$tag.show"} ne 'yes') {
	print XML ("
	\t\t<show>".$insertlist{"$tag.show"}."</show>");
	}
	if (defined($insertlist{"$tag.helpfile"})) {
	print XML ("
	\t\t<help>
	\t\t\t<file>".$insertlist{"$tag.helpfile"}."</file>");
	if ($insertlist{"$tag.helpdesc"} ne '') {
	print XML ("
	\t\t\t<description>".$insertlist{"$tag.helpdesc"}."</description>");
	}
	print XML ("
	\t\t</help>");
	}
	if (defined($insertlist{"$tag.which"})) {
	print XML ("
	\t\t<allow>".join(',',sort(@{ $insertlist{"$tag.which"} }))."</allow>");
	}
	print XML ("
	\t</tag>");
	$i++;
	}
	print XML ("\n</insertlist>\n");
	close(XML);
}	}

sub description {	sub description {
my ($token)=@_;	my ($token)=@_;
my $tagnum;	my $tag = &get_tag($token);
my $tag=$token->[1];	return $insertlist{$tag.'.description'};
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'};
}	}

# Returns a list containing the help file, and the description	# Returns a list containing the help file, and the description
sub helpinfo {	sub helpinfo {
my ($token)=@_;	my ($token)=@_;
my $tagnum;	my $tag = &get_tag($token);
my $tag=$token->[1];	return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
foreach my $namespace (reverse @Apache::lonxml::namespace) {	}
my $testtag=$namespace.'::'.$tag;
$tagnum=$insertlist{"$testtag.num"};	sub get_tag {
if (defined($tagnum)) { last; }	my ($token)=@_;
}	my $tagnum;
if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }	my $tag=$token->[1];
return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});	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;	1;

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

Removed from v.1.429
changed lines
	Added in v.1.451