--- loncom/xml/lonxml.pm 2001/11/29 21:38:17 1.140
+++ loncom/xml/lonxml.pm 2002/03/06 20:28:19 1.155
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.140 2001/11/29 21:38:17 albertel Exp $
+# $Id: lonxml.pm,v 1.155 2002/03/06 20:28:19 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -51,7 +51,12 @@
# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer
# Guy Albertelli
# 9/26 Gerd Kortemeyer
-
+# Dec Guy Albertelli
+# YEAR=2002
+# 1/1 Gerd Kortemeyer
+# 1/2 Matthew Hall
+# 1/3 Gerd Kortemeyer
+#
package Apache::lonxml;
use vars
@@ -66,15 +71,23 @@ use Math::Random qw(:all);
use Opcode;
sub register {
- my $space;
- my @taglist;
- my $temptag;
- ($space,@taglist) = @_;
- foreach $temptag (@taglist) {
- $Apache::lonxml::alltags{$temptag}=$space;
+ my ($space,@taglist) = @_;
+ foreach my $temptag (@taglist) {
+ push(@{ $Apache::lonxml::alltags{$temptag} },$space);
}
}
+sub deregister {
+ my ($space,@taglist) = @_;
+ foreach my $temptag (@taglist) {
+ my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
+ if ($tempspace eq $space) {
+ pop(@{ $Apache::lonxml::alltags{$temptag} });
+ }
+ }
+ #&printalltags();
+}
+
use Apache::Constants qw(:common);
use Apache::lontexconvert;
use Apache::style;
@@ -277,11 +290,14 @@ sub printtokenheader {
$reply{'generation'};
if ($target eq 'web') {
+ my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
return
'<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.
'Checked out for '.$plainname.
'<br />User: '.$tuname.' at '.$tudom.
+ '<br />ID: '.$idhash{$tuname}.
'<br />CourseID: '.$tcrsid.
+ '<br />Course: '.$ENV{'course.'.$tcrsid.'.description'}.
'<br />DocID: '.$token.
'<br />Time: '.localtime().'<hr />';
} else {
@@ -300,6 +316,8 @@ sub fontsettings() {
sub registerurl {
my $forcereg=shift;
+ my $target = shift;
+ my $result = '';
if ($ENV{'request.publicaccess'}) {
return
'<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
@@ -331,7 +349,7 @@ ENDGRDS
ENDPARM
}
}
- return (<<ENDREGTHIS);
+ $result = (<<ENDREGTHIS);
<script language="JavaScript">
// BEGIN LON-CAPA Internal
@@ -383,7 +401,7 @@ ENDPARM
ENDREGTHIS
} else {
- return (<<ENDDONOTREGTHIS);
+ $result = (<<ENDDONOTREGTHIS);
<script language="JavaScript">
// BEGIN LON-CAPA Internal
@@ -410,8 +428,30 @@ ENDREGTHIS
// END LON-CAPA Internal
</script>
ENDDONOTREGTHIS
-
}
+ if ($target eq 'edit') {
+ $result .=<<"ENDBROWSERSCRIPT";
+<script>
+ var editform;
+ function openbrowser(formname,elementname) {
+ var url = '/res/?';
+ if (editform == null) {
+ url += 'launch=1&';
+ }
+ url += 'catalogmode=interactive&';
+ url += 'mode=edit&';
+ url += 'form=' + formname + '&';
+ url += 'element=' + elementname + '';
+ var title = 'Browser';
+ var options = 'scrollbars=1,resizable=1,menubar=0';
+ options += ',width=700,height=600';
+ editform = open(url,title,options,'1');
+ editform.focus();
+ }
+</script>
+ENDBROWSERSCRIPT
+ }
+ return $result;
}
sub loadevents() {
@@ -425,7 +465,8 @@ sub unloadevents() {
sub printalltags {
my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {
- &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
+ &Apache::lonxml::debug("$temp -- ".
+ join(',',@{ $Apache::lonxml::alltags{$temp} }));
}
}
@@ -446,7 +487,7 @@ sub xmlparse {
($target, my @tenta) = split('&&',$target);
- my @stack = ();
+ my @stack = ();
my @parstack = ();
&initdepth;
@@ -516,8 +557,14 @@ sub inner_xmlparse {
} elsif ($token->[0] eq 'E') {
#clear out any tags that didn't end
while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
- &Apache::lonxml::warning('Missing tag </'.$$stack['-1'].'> in file');
- &end_tag($stack,$parstack,$token);
+ my $lasttag=$$stack[-1];
+ if ($token->[1] =~ /^$lasttag$/i) {
+ &Apache::lonxml::warning('Using tag </'.$token->[1].'> as end tag to <'.$$stack[-1].'>');
+ last;
+ } else {
+ &Apache::lonxml::warning('Found tag </'.$token->[1].'> when looking for </'.$$stack[-1].'> in file');
+ &end_tag($stack,$parstack,$token);
+ }
}
if (exists($$style_for_target{'/'."$token->[1]"})) {
@@ -596,10 +643,16 @@ sub recurse {
$safeeval, $style_for_target);
} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end
- while ($tokenpat->[1] ne $innerstack[$#innerstack]
+ while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > -1)) {
- &Apache::lonxml::warning('Missing tag </'.$innerstack['-1'].'> in style');
- &end_tag(\@innerstack,\@innerparstack,$tokenpat);
+ my $lasttag=$innerstack[-1];
+ if ($tokenpat->[1] =~ /^$lasttag$/i) {
+ &Apache::lonxml::warning('Using tag </'.$tokenpat->[1].'> as end tag to <'.$innerstack[-1].'>');
+ last;
+ } else {
+ &Apache::lonxml::warning('Found tag </'.$tokenpat->[1].'> when looking for </'.$innerstack[-1].'> in file');
+ &end_tag(\@innerstack,\@innerparstack,$tokenpat);
+ }
}
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
\@innerstack, \@innerparstack, \@pat,
@@ -644,11 +697,11 @@ sub callsub {
my $sub1;
no strict 'refs';
my $tag=$token->[1];
- my $space=$Apache::lonxml::alltags{$tag};
+ my $space=$Apache::lonxml::alltags{$tag}[-1];
if (!$space) {
- $tag=~tr/A-Z/a-z/;
+ $tag=~tr/A-Z/a-z/;
$sub=~tr/A-Z/a-z/;
- $space=$Apache::lonxml::alltags{$tag}
+ $space=$Apache::lonxml::alltags{$tag}[-1]
}
my $deleted=0;
@@ -660,13 +713,13 @@ sub callsub {
}
if (!$deleted) {
if ($space) {
- #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
+ #&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
$sub1="$space\:\:$sub";
($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
$parstack,$parser,$safeeval,
$style);
} else {
- #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
+ #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {
$currentstring = $token->[4];
@@ -868,10 +921,10 @@ sub get_all_text {
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
- if ($token->[1] eq $tag) { $depth++; }
+ if ($token->[1] =~ /^$tag$/i) { $depth++; }
$result.=$token->[4];
} elsif ($token->[0] eq 'E') {
- if ( $token->[1] eq $tag) { $depth--; }
+ if ( $token->[1] =~ /^$tag$/i) { $depth--; }
#skip sending back the last end tag
if ($depth > -1) { $result.=$token->[2]; } else {
$pars->unget_token($token);
@@ -886,7 +939,7 @@ sub get_all_text {
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
- if ( $token->[1] eq $tag) {
+ if ( $token->[1] =~ /^$tag$/i) {
$pars->unget_token($token); last;
} else {
$result.=$token->[4];
@@ -916,14 +969,14 @@ sub newparser {
sub parstring {
my ($token) = @_;
my $temp='';
- map {
+ foreach (@{$token->[3]}) {
unless ($_=~/\W/) {
my $val=$token->[2]->{$_};
- $val =~ s/([\%\@\\])/\\$1/g;
+ $val =~ s/([\%\@\\\"])/\\$1/g;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";"
}
- } @{$token->[3]};
+ }
return $temp;
}
@@ -936,10 +989,10 @@ sub writeallows {
my $thisdir=$thisurl;
$thisdir=~s/\/[^\/]+$//;
my %httpref=();
- map {
+ foreach (@extlinks) {
$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
- } @extlinks;
+ }
@extlinks=();
&Apache::lonnet::appenv(%httpref);
}
@@ -949,31 +1002,23 @@ sub writeallows {
#
sub afterburn {
my $result=shift;
- map {
- my ($name, $value) = split(/=/,$_);
- $value =~ tr/+/ /;
- $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
- unless ($ENV{'form.'.$name}) {
- $ENV{'form.'.$name}=$value;
- }
- }
- } (split(/&/,$ENV{'QUERY_STRING'}));
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['highlight','anchor','link']);
if ($ENV{'form.highlight'}) {
- map {
+ foreach (split(/\,/,$ENV{'form.highlight'})) {
my $anchorname=$_;
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
- } split(/\,/,$ENV{'form.highlight'});
+ }
}
if ($ENV{'form.link'}) {
- map {
+ foreach (split(/\,/,$ENV{'form.link'})) {
my ($anchorname,$linkurl)=split(/\>/,$_);
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
- } split(/\,/,$ENV{'form.link'});
+ }
}
if ($ENV{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};
@@ -994,13 +1039,13 @@ sub storefile {
if (my $fh=Apache::File->new('>'.$file)) {
print $fh $contents;
$fh->close();
+ } else {
+ &warning("Unable to save file $file");
}
}
-sub inserteditinfo {
- my ($result,$filecontents)=@_;
- unless ($filecontents) {
- $filecontents=(<<SIMPLECONTENT);
+sub createnewhtml {
+ my $filecontents=(<<SIMPLECONTENT);
<html>
<head>
<title>
@@ -1014,28 +1059,63 @@ sub inserteditinfo {
</body>
</html>
SIMPLECONTENT
- }
- my $editheader='<a href="#editsection">Edit below</a><hr />';
+ return $filecontents;
+}
+
+
+sub inserteditinfo {
+ my ($result,$filecontents)=@_;
+ $filecontents =~ s:</textarea>:</textarea>:ig;
+# my $editheader='<a href="#editsection">Edit below</a><hr />';
my $editfooter=(<<ENDFOOTER);
<hr />
<a name="editsection" />
<form method="post">
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
<br />
+<input type="hidden" name="showmode" value="Edit" />
<input type="submit" name="attemptclean"
value="Save and then attempt to clean HTML" />
<input type="submit" name="savethisfile" value="Save this" />
+<input type="submit" name="showmode" value="View" />
</form>
ENDFOOTER
- $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
+# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;
return $result;
}
+sub get_target {
+ my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
+ if ( $ENV{'request.state'} eq 'published') {
+ if ( defined($ENV{'form.grade_target'})
+ && ($viewgrades == 'F' )) {
+ return ($ENV{'form.grade_target'});
+ } elsif (defined($ENV{'form.grade_target'})) {
+ if (($ENV{'form.grade_target'} eq 'web') ||
+ ($ENV{'form.grade_target'} eq 'tex') ) {
+ return $ENV{'form.grade_target'}
+ } else {
+ return 'web';
+ }
+ } else {
+ return 'web';
+ }
+ } elsif ($ENV{'request.state'} eq 'construct') {
+ if ( defined($ENV{'form.grade_target'})) {
+ return ($ENV{'form.grade_target'});
+ } else {
+ return 'web';
+ }
+ } else {
+ return 'web';
+ }
+}
+
sub handler {
my $request=shift;
- my $target='web';
+ my $target=&get_target();
$Apache::lonxml::debug=0;
@@ -1044,9 +1124,9 @@ sub handler {
} else {
$request->content_type('text/html');
}
- &Apache::loncommon::no_cache($request);
+ &Apache::loncommon::no_cache($request);
$request->send_http_header;
-
+
return OK if $request->header_only;
@@ -1060,7 +1140,7 @@ sub handler {
}
}
my %mystyle;
- my $result = '';
+ my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents == -1) {
$result=(<<ENDNOTFOUND);
@@ -1074,60 +1154,72 @@ sub handler {
</html>
ENDNOTFOUND
$filecontents='';
+ if ($ENV{'request.state'} ne 'published') {
+ $filecontents=&createnewhtml();
+ $ENV{'form.showmode'}='Edit'; #force edit mode
+ }
} else {
- unless ($ENV{'request.state'} eq 'published') {
- if ($ENV{'form.attemptclean'}) {
- $filecontents=&htmlclean($filecontents,1);
- }
+ unless ($ENV{'request.state'} eq 'published') {
+ if ($ENV{'form.attemptclean'}) {
+ $filecontents=&htmlclean($filecontents,1);
}
- $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
+ }
+ if ($ENV{'form.showmode'} ne 'Edit') {
+ $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
+ }
}
#
# Edit action? Insert editing commands
#
unless ($ENV{'request.state'} eq 'published') {
+ if ($ENV{'form.showmode'} eq 'Edit') {
+ $result='<html><body bgcolor="#FFFFFF"></body></html>';
$result=&inserteditinfo($result,$filecontents);
+ }
}
-
+
writeallows($request->uri);
$request->print($result);
return OK;
}
-
+
sub debug {
if ($Apache::lonxml::debug eq 1) {
- print("DEBUG:".$_[0]."<br />\n");
+ $|=1;
+ print("DEBUG:".join('<br />',@_)."<br />\n");
}
}
sub error {
if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
- print "<b>ERROR:</b>".$_[0]."<br />\n";
+ print "<b>ERROR:</b>".join('<br />',@_)."<br />\n";
} else {
print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
#notify author
- &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
+ &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
#notify course
if ( $ENV{'request.course.id'} ) {
my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
+ my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
foreach my $user (split /\,/, $users) {
($user,my $domain) = split /:/, $user;
- &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
+ &Apache::lonmsg::user_normal_msg($user,$domain,
+ "Error [$declutter]",join('<br />',@_));
}
}
#FIXME probably shouldn't have me get everything forever.
- &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
+ &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));
#&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
}
}
sub warning {
if ($ENV{'request.state'} eq 'construct') {
- print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
+ print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
}
}
@@ -1184,7 +1276,7 @@ sub register_insert {
my $line = $data[$i];
my ($mnemonic,@which) = split(/ +/,$line);
my $tag = $insertlist{"$tagnum.tag"};
- for (my $j=0;$j <$#which;$j++) {
+ for (my $j=0;$j <=$#which;$j++) {
if ( $which[$j] eq 'Y' ) {
if ($insertlist{"$j.show"} ne 'no') {
push(@{ $insertlist{"$tag.which"} },$j);