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.449

version 1.440, 2007/02/23 00:39:35	version 1.449, 2007/08/03 23:29:54
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 124 $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 315 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 356 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 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 951 sub decreasedepth {	Line 968 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 990 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 1000 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 1202 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 1221 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 1692 sub get_param_var {	Line 1741 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 1754 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 1768 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 1783 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.449