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.440 and 1.462

version 1.440, 2007/02/23 00:39:35	version 1.462, 2007/10/08 09:20:22
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 91 use Apache::loncacc();	Line 92 use Apache::loncacc();
use Apache::lonmaxima();	use Apache::lonmaxima();
use Apache::lonlocal;	use Apache::lonlocal;

#================================================== Main subroutine: xmlparse	#==================================== Main subroutine: xmlparse

#debugging control, to turn on debugging modify the correct handler	#debugging control, to turn on debugging modify the correct handler

$Apache::lonxml::debug=0;	$Apache::lonxml::debug=0;

# keeps count of the number of warnings and errors generated in a parse	# keeps count of the number of warnings and errors generated in a parse
Line 124 $evaluate = 1;	Line 127 $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 131 $Apache::lonxml::request='';	Line 137 $Apache::lonxml::request='';
$Apache::lonxml::counter=1;	$Apache::lonxml::counter=1;
$Apache::lonxml::counter_changed=0;	$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	#internal check on whether to look at style defs
$Apache::lonxml::usestyle=1;	$Apache::lonxml::usestyle=1;

Line 315 sub xmlparse {	Line 331 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 356 sub xmlparse {	Line 373 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 585 sub callsub {	Line 607 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 611 sub setup_globals {	Line 639 sub setup_globals {
$Apache::lonxml::default_homework_loaded=0;	$Apache::lonxml::default_homework_loaded=0;
$Apache::lonxml::usestyle=1;	$Apache::lonxml::usestyle=1;
&init_counter();	&init_counter();
	&clear_bubble_lines_for_part();
@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 783 sub init_safespace {	Line 813 sub init_safespace {
$safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');	$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_get_seed,$safeeval,'&random_get_seed');
$safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_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::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
$safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');	$safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');	$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
Line 891 sub endredirection {	Line 922 sub endredirection {
}	}
pop @Apache::lonxml::outputstack;	pop @Apache::lonxml::outputstack;
}	}
	sub in_redirection {
	return ($Apache::lonxml::redirection > 0)
	}

sub end_tag {	sub end_tag {
my ($tagstack,$parstack,$token)=@_;	my ($tagstack,$parstack,$token)=@_;
Line 951 sub decreasedepth {	Line 985 sub decreasedepth {
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 988 sub get_all_text_unbalanced {	Line 1022 sub get_all_text_unbalanced {
}	}
}	}
return $result	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 {	sub increment_counter {
my ($increment) = @_;	my ($increment, $part_id) = @_;
if (defined($increment) && $increment gt 0) {	if (!defined($increment) \|\| $increment le 0) {
$Apache::lonxml::counter+=$increment;	$increment = 1;
} else {
$Apache::lonxml::counter++;
}	}
	$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;	$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 1045 sub store_counter {	Line 1127 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 {	sub get_all_text {
my($tag,$pars,$style)= @_;	my($tag,$pars,$style)= @_;
my $gotfullstack=1;	my $gotfullstack=1;
Line 1202 sub writeallows {	Line 1352 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 1221 sub do_registered_ssi {	Line 1371 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 1301 SIMPLECONTENT	Line 1457 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='';
if ($filetype eq 'html') {	my $textarea_id = 'filecont';
my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();	my ($add_to_onload, $add_to_onresize);
$initialize=&Apache::lonhtmlcommon::spellheader();	my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
if (!&Apache::lonhtmlcommon::htmlareablocked() &&	$initialize=&Apache::lonhtmlcommon::spellheader();
&Apache::lonhtmlcommon::htmlareabrowser()) {	if ($filetype eq 'html'
$initialize.=(<<FULLPAGE);	&& (!&Apache::lonhtmlcommon::htmlareablocked() &&
	&Apache::lonhtmlcommon::htmlareabrowser())) {
	$textarea_id .= '_htmlarea';
	$initialize.=(<<FULLPAGE);
<script type="text/javascript">	<script type="text/javascript">
$addbuttons	$addbuttons

Line 1321 $addbuttons	Line 1480 $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);
	editor._iframe.id = '$textarea_id';
	resize_textarea('$textarea_id','LC_aftertextarea');
	},300);
}	}
</script>	</script>
FULLPAGE	FULLPAGE
} else {	} else {
$initialize.=(<<FULLPAGE);	$initialize.=(<<FULLPAGE);
<script type="text/javascript">	<script type="text/javascript">
$addbuttons	$addbuttons
function initDocument() {	function initDocument() {
	resize_textarea('$textarea_id','LC_aftertextarea');
}	}
</script>	</script>
FULLPAGE	FULLPAGE
}	}
$result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;
	$add_to_onload = 'initDocument();';
	$add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";

	if ($filetype eq 'html') {
$xml_help=&Apache::loncommon::helpLatexCheatsheet();	$xml_help=&Apache::loncommon::helpLatexCheatsheet();
}	}

my $cleanbut = '';	my $cleanbut = '';

my $titledisplay=&display_title();	my $titledisplay=&display_title();
Line 1347 FULLPAGE	Line 1519 FULLPAGE
my $buttons=(<<BUTTONS);	my $buttons=(<<BUTTONS);
$cleanbut	$cleanbut
<input type="submit" name="discardview" accesskey="d" value="$lt{'dv'}" />	<input type="submit" name="discardview" accesskey="d" value="$lt{'dv'}" />
<input type="submit" name="Undo" accesskey="u" value="$lt{'un'}" /><hr>	<input type="submit" name="Undo" accesskey="u" value="$lt{'un'}" /><hr />
<input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />	<input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />
<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>
	<div id="LC_aftertextarea">
<br />$buttons	<br />$buttons
<br />	<br />
</form>
$titledisplay	$titledisplay
	</div>
	</form>
</body>	</body>
ENDFOOTER	ENDFOOTER
# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;	return ($editfooter,$add_to_onload,$add_to_onresize);;
$result=~s/(\<\/body\>)/$editfooter/is;
return $result;
}	}

sub get_target {	sub get_target {
Line 1465 ENDNOTFOUND	Line 1639 ENDNOTFOUND
['editmode']);	['editmode']);
}	}
if (!$env{'form.editmode'} \|\| $env{'form.viewmode'} \|\| $env{'form.discardview'}) {	if (!$env{'form.editmode'} \|\| $env{'form.viewmode'} \|\| $env{'form.discardview'}) {
	&Apache::structuretags::reset_problem_globals();
$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,	$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
'',%mystyle);	'',%mystyle);
undef($Apache::lonhomework::parsing_a_task);	# .html files may contain <problem> or <Task> need to clean
	# up if it did
	&Apache::structuretags::reset_problem_globals();
	&Apache::lonhomework::finished_parsing();
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['rawmode']);	['rawmode']);
if ($env{'form.rawmode'}) { $result = $filecontents; }	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	# Edit action? Insert editing commands
#	#
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, $add_to_onresize)=
	&inserteditinfo($filecontents,$filetype);

my $displayfile=$request->uri;	my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;	$displayfile=~s/^\/[^\/]*//;
my %options = ();	my %options =
	('add_entries' =>
	{'onresize' => $add_to_onresize,
	'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().
	&Apache::loncommon::resize_textarea_js();
	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 1545 sub show_error_warn_msg {	Line 1745 sub show_error_warn_msg {
}	}

sub error {	sub error {
	my @errors = @_;

$errorcount++;	$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 ( &show_error_warn_msg() ) {
# If printing in construction space, put the error inside <pre></pre>	# If printing in construction space, put the error inside <pre></pre>
push(@Apache::lonxml::error_messages,	push(@Apache::lonxml::error_messages,
$Apache::lonxml::warnings_error_header.	$Apache::lonxml::warnings_error_header.
"<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");	"<b>ERROR:</b>".join("<br />\n",@errors)."<br />\n");
$Apache::lonxml::warnings_error_header='';	$Apache::lonxml::warnings_error_header='';
} else {	} else {
my $errormsg;	my $errormsg;
Line 1560 sub error {	Line 1776 sub error {
$errormsg=&mt("An error occured while processing this resource. The author has been notified.");	$errormsg=&mt("An error occured while processing this resource. The author has been notified.");
}	}
my $host=$Apache::lonnet::perlvar{'lonHostID'};	my $host=$Apache::lonnet::perlvar{'lonHostID'};
my $msg = join('<br />',(@_,"The error occurred on host <tt>$host</tt>"));	push(@errors, "The error occurred on host <tt>$host</tt>");

	my $msg = join('<br />', @errors);

#notify author	#notify author
&Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);	&Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
#notify course	#notify course
Line 1692 sub get_param_var {	Line 1911 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 {	sub register_insert_xml {
my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}	my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
.'/insertlist.xml');	.'/insertlist.xml');
my ($tagnum,$in_help)=(0,0);	my ($tagnum,$in_help)=(0,0);
	my @alltags;
my $tag;	my $tag;
while (my $token = $parser->get_token()) {	while (my $token = $parser->get_token()) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
Line 1744 sub register_insert_xml {	Line 1924 sub register_insert_xml {
$tag = $token->[2]{'name'};	$tag = $token->[2]{'name'};
$insertlist{"$tagnum.tag"} = $tag;	$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tag.num"} = $tagnum;	$insertlist{"$tag.num"} = $tagnum;
	push(@alltags,$tag);
} elsif ($in_help && $token->[1] eq 'file') {	} elsif ($in_help && $token->[1] eq 'file') {
$key = $tag.'.helpfile';	$key = $tag.'.helpfile';
} elsif ($in_help && $token->[1] eq 'description') {	} elsif ($in_help && $token->[1] eq 'description') {
Line 1757 sub register_insert_xml {	Line 1938 sub register_insert_xml {
} elsif ($token->[1] eq 'help') {	} elsif ($token->[1] eq 'help') {
$in_help=1;	$in_help=1;
} elsif ($token->[1] eq 'allow') {	} elsif ($token->[1] eq 'allow') {
my $allow = $parser->get_text();	$key = $tag.'.allow';
foreach my $element (split(',',$allow)) {
$element =~ s/(^\s\|\s$ )//gx;
push(@{ $insertlist{$tag.'.which'} },$element);
}
}	}
if (defined($key)) {	if (defined($key)) {
$insertlist{$key} = $parser->get_text();	$insertlist{$key} = $parser->get_text();
Line 1776 sub register_insert_xml {	Line 1953 sub register_insert_xml {
}	}
}	}
}	}

	# parse the allows and ignore tags set to <show>no</show>
	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 {	sub register_insert {
# &register_insert_tab(@_);
# &dump_insertlist('1');
# undef(%insertlist);
return &register_insert_xml(@_);	return &register_insert_xml(@_);
# &dump_insertlist('2');	# &dump_insertlist('2');
}	}

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

Removed from v.1.440
changed lines
	Added in v.1.462