version 1.268, 2003/08/06 14:30:01
|
version 1.273, 2003/08/21 15:51:41
|
Line 69 use Safe::Hole();
|
Line 69 use Safe::Hole();
|
use Math::Cephes(); |
use Math::Cephes(); |
use Math::Random(); |
use Math::Random(); |
use Opcode(); |
use Opcode(); |
|
use POSIX qw(strftime); |
|
|
|
|
sub register { |
sub register { |
Line 477 sub htmlclean {
|
Line 478 sub htmlclean {
|
} |
} |
|
|
sub latex_special_symbols { |
sub latex_special_symbols { |
my ($current_token,$stack,$parstack,$where)=@_; |
my ($string,$where)=@_; |
if ($where eq 'header') { |
if ($where eq 'header') { |
$current_token =~ s/(\\|_|\^)/ /g; |
$string =~ s/(\\|_|\^)/ /g; |
$current_token =~ s/(\$|%|\#|&|\{|\})/\\$1/g; |
$string =~ s/(\$|%|\#|&|\{|\})/\\$1/g; |
|
$string =~ s/_/ /g; |
} else { |
} else { |
$current_token=~s/\\ /\\char92 /g; |
$string=~s/\\ /\\char92 /g; |
$current_token=~s/\^/\\char94 /g; |
$string=~s/\^/\\char94 /g; |
$current_token=~s/\~/\\char126 /g; |
$string=~s/\~/\\char126 /g; |
$current_token=~s/(&[^A-Za-z\#])/\\$1/g; |
$string=~s/(&[^A-Za-z\#])/\\$1/g; |
$current_token=~s/([^&])\#/$1\\#/g; |
$string=~s/([^&])\#/$1\\#/g; |
$current_token=~s/(\$|_|{|})/\\$1/g; |
$string=~s/(\$|_|{|})/\\$1/g; |
$current_token=~s/\\char92 /\\texttt{\\char92}/g; |
$string=~s/\\char92 /\\texttt{\\char92}/g; |
$current_token=~s/(>|<)/\$$1\$/g; #more or less |
$string=~s/(>|<)/\$$1\$/g; #more or less |
if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit |
if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit |
if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space |
if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space |
if ($current_token eq '%.') {$current_token = '\%.';} #persent at the end of statement |
if ($string eq '%.') {$string = '\%.';} #percent at the end of statement |
} |
} |
return $current_token; |
return $string; |
} |
} |
|
|
sub inner_xmlparse { |
sub inner_xmlparse { |
Line 584 sub inner_xmlparse {
|
Line 586 sub inner_xmlparse {
|
if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { |
if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { |
#Style file definitions should be correct |
#Style file definitions should be correct |
if ($target eq 'tex' && ($Apache::lonxml::usestyle)) { |
if ($target eq 'tex' && ($Apache::lonxml::usestyle)) { |
$result=&latex_special_symbols($result,$stack,$parstack); |
$result=&latex_special_symbols($result); |
} |
} |
} |
} |
|
|
Line 952 sub store_counter {
|
Line 954 sub store_counter {
|
} |
} |
|
|
sub get_all_text { |
sub get_all_text { |
my($tag,$pars)= @_; |
my($tag,$pars,$style)= @_; |
&Apache::lonxml::debug("Got a ".ref($pars)); |
&Apache::lonxml::debug("Got a ".ref($pars)); |
my $gotfullstack=1; |
my $gotfullstack=1; |
if (ref($pars) ne 'ARRAY') { |
if (ref($pars) ne 'ARRAY') { |
$gotfullstack=0; |
$gotfullstack=0; |
$pars=[$pars]; |
$pars=[$pars]; |
} |
} |
my $depth=0; |
&Apache::lonxml::debug("Got a ".ref($style)); |
my $token; |
if (ref($style) ne 'HASH') { |
my $result=''; |
$style={}; |
if ( $tag =~ m:^/: ) { |
} else { |
my $tag=substr($tag,1); |
&Apache::lonhomework::showhash(%$style); |
#&Apache::lonxml::debug("have:$tag:"); |
} |
my $top_empty=0; |
my $depth=0; |
while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) { |
my $token; |
while (($depth >=0) && ($token = $$pars[-1]->get_token)) { |
my $result=''; |
#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd); |
if ( $tag =~ m:^/: ) { |
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { |
my $tag=substr($tag,1); |
$result.=$token->[1]; |
#&Apache::lonxml::debug("have:$tag:"); |
} elsif ($token->[0] eq 'PI') { |
my $top_empty=0; |
$result.=$token->[2]; |
while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) { |
} elsif ($token->[0] eq 'S') { |
while (($depth >=0) && ($token = $$pars[-1]->get_token)) { |
if ($token->[1] =~ /^$tag$/i) { $depth++; } |
#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd); |
$result.=$token->[4]; |
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { |
} elsif ($token->[0] eq 'E') { |
$result.=$token->[1]; |
if ( $token->[1] =~ /^$tag$/i) { $depth--; } |
} elsif ($token->[0] eq 'PI') { |
#skip sending back the last end tag |
$result.=$token->[2]; |
if ($depth > -1) { $result.=$token->[2]; } else { |
} elsif ($token->[0] eq 'S') { |
$$pars[-1]->unget_token($token); |
if ($token->[1] =~ /^$tag$/i) { $depth++; } |
} |
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; } |
} |
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; } |
} |
$result.=$token->[4]; |
if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; } |
} elsif ($token->[0] eq 'E') { |
if (($depth >=0) && ($#$pars > 0) ) { |
if ( $token->[1] =~ /^$tag$/i) { $depth--; } |
pop(@$pars); |
#skip sending back the last end tag |
pop(@Apache::lonxml::pwd); |
if ($depth == 0 && exists($$style{'/'.$token->[1]})) { |
} |
my $string= |
} |
'<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'. |
if ($top_empty && $depth >= 0) { |
$$style{'/'.$token->[1]}. |
#never found the end tag ran out of text, throw error send back blank |
$token->[2]. |
&error('Never found end tag for <'.$tag.'>'); |
'<LONCAPA_INTERNAL_TURN_STYLE_ON />'; |
if ($gotfullstack) { |
&Apache::lonxml::newparser($pars,\$string); |
my $newstring='</'.$tag.'>'.$result; |
#&Apache::lonxml::debug("reParsing $string"); |
&Apache::lonxml::newparser($pars,\$newstring); |
next; |
} |
} |
$result=''; |
if ($depth > -1) { |
} |
$result.=$token->[2]; |
} else { |
} else { |
while ($#$pars > -1) { |
$$pars[-1]->unget_token($token); |
while ($token = $$pars[-1]->get_token) { |
} |
#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); |
} |
if (($token->[0] eq 'T')||($token->[0] eq 'C')|| |
} |
($token->[0] eq 'D')) { |
if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; } |
$result.=$token->[1]; |
if (($depth >=0) && ($#$pars > 0) ) { |
} elsif ($token->[0] eq 'PI') { |
pop(@$pars); |
$result.=$token->[2]; |
pop(@Apache::lonxml::pwd); |
} elsif ($token->[0] eq 'S') { |
} |
if ( $token->[1] =~ /^$tag$/i) { |
} |
$$pars[-1]->unget_token($token); last; |
if ($top_empty && $depth >= 0) { |
} else { |
#never found the end tag ran out of text, throw error send back blank |
$result.=$token->[4]; |
&error('Never found end tag for <'.$tag. |
} |
'> current string <pre>'. |
} elsif ($token->[0] eq 'E') { |
&HTML::Entities::encode($result). |
$result.=$token->[2]; |
'</pre>'); |
} |
if ($gotfullstack) { |
} |
my $newstring='</'.$tag.'>'.$result; |
if (($#$pars > 0) ) { |
&Apache::lonxml::newparser($pars,\$newstring); |
pop(@$pars); |
} |
pop(@Apache::lonxml::pwd); |
$result=''; |
} else { last; } |
} |
} |
} else { |
} |
while ($#$pars > -1) { |
if ($result =~ m|<LONCAPA_INTERNAL_TURN_STYLE_ON />|) { |
while ($token = $$pars[-1]->get_token) { |
$Apache::lonxml::usestyle=1; |
#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); |
} |
if (($token->[0] eq 'T')||($token->[0] eq 'C')|| |
#&Apache::lonxml::debug("Exit:$result:"); |
($token->[0] eq 'D')) { |
return $result |
$result.=$token->[1]; |
|
} elsif ($token->[0] eq 'PI') { |
|
$result.=$token->[2]; |
|
} elsif ($token->[0] eq 'S') { |
|
if ( $token->[1] =~ /^$tag$/i) { |
|
$$pars[-1]->unget_token($token); last; |
|
} else { |
|
$result.=$token->[4]; |
|
} |
|
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; } |
|
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; } |
|
} elsif ($token->[0] eq 'E') { |
|
$result.=$token->[2]; |
|
} |
|
} |
|
if (($#$pars > 0) ) { |
|
pop(@$pars); |
|
pop(@Apache::lonxml::pwd); |
|
} else { last; } |
|
} |
|
} |
|
#&Apache::lonxml::debug("Exit:$result:"); |
|
return $result |
} |
} |
|
|
sub newparser { |
sub newparser { |
Line 1115 sub storefile {
|
Line 1139 sub storefile {
|
if (my $fh=Apache::File->new('>'.$file)) { |
if (my $fh=Apache::File->new('>'.$file)) { |
print $fh $contents; |
print $fh $contents; |
$fh->close(); |
$fh->close(); |
|
return 1; |
} else { |
} else { |
&warning("Unable to save file $file"); |
&warning("Unable to save file $file"); |
|
return 0; |
} |
} |
} |
} |
|
|
Line 1220 sub handler {
|
Line 1246 sub handler {
|
# |
# |
unless ($ENV{'request.state'} eq 'published') { |
unless ($ENV{'request.state'} eq 'published') { |
if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { |
if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { |
&storefile($file,$ENV{'form.filecont'}); |
if (&storefile($file,$ENV{'form.filecont'})) { |
|
$request->print("<font COLOR=\"#0000FF\">Updated: ". strftime("%d %b %H:%M:%S",localtime())." </font>"); |
|
} |
} |
} |
} |
} |
my %mystyle; |
my %mystyle; |
Line 1460 sub whichuser {
|
Line 1488 sub whichuser {
|
my ($symb,$courseid,$domain,$name,$publicuser); |
my ($symb,$courseid,$domain,$name,$publicuser); |
if (defined($ENV{'form.grade_symb'})) { |
if (defined($ENV{'form.grade_symb'})) { |
my $tmp_courseid=$ENV{'form.grade_courseid'}; |
my $tmp_courseid=$ENV{'form.grade_courseid'}; |
my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid); |
my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid); |
if ($allowed) { |
if ($allowed) { |
$symb=$ENV{'form.grade_symb'}; |
$symb=$ENV{'form.grade_symb'}; |
$courseid=$ENV{'form.grade_courseid'}; |
$courseid=$ENV{'form.grade_courseid'}; |