--- loncom/xml/lonxml.pm 2001/12/21 22:44:06 1.142 +++ loncom/xml/lonxml.pm 2002/01/18 17:04:46 1.150 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.142 2001/12/21 22:44:06 albertel Exp $ +# $Id: lonxml.pm,v 1.150 2002/01/18 17:04:46 albertel 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 @@ -285,11 +290,14 @@ sub printtokenheader { $reply{'generation'}; if ($target eq 'web') { + my %idhash=&Apache::lonnet::idrget($tudom,($tuname)); return ''. 'Checked out for '.$plainname. '
User: '.$tuname.' at '.$tudom. + '
ID: '.$idhash{$tuname}. '
CourseID: '.$tcrsid. + '
Course: '.$ENV{'course.'.$tcrsid.'.description'}. '
DocID: '.$token. '
Time: '.localtime().'
'; } else { @@ -455,7 +463,7 @@ sub xmlparse { ($target, my @tenta) = split('&&',$target); - my @stack = (); + my @stack = (); my @parstack = (); &initdepth; @@ -525,8 +533,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 </'.$$stack[-1].'> when looking for </'.$token->[1].'> in file'); + &end_tag($stack,$parstack,$token); + } } if (exists($$style_for_target{'/'."$token->[1]"})) { @@ -605,10 +619,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 </'.$innerstack[-1].'> when looking for </'.$tokenpat->[1].'> in file'); + &end_tag(\@innerstack,\@innerparstack,$tokenpat); + } } $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, \@innerstack, \@innerparstack, \@pat, @@ -928,7 +948,7 @@ sub parstring { 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\";" } @@ -1003,6 +1023,8 @@ sub storefile { if (my $fh=Apache::File->new('>'.$file)) { print $fh $contents; $fh->close(); + } else { + &warning("Unable to save file $file"); } } @@ -1024,19 +1046,23 @@ sub inserteditinfo { SIMPLECONTENT } - my $editheader='Edit below
'; + + $filecontents =~ s::</textarea>:ig; +# my $editheader='Edit below
'; my $editfooter=(<

+ +
ENDFOOTER - $result=~s/(\]*\>)/$1$editheader/is; +# $result=~s/(\]*\>)/$1$editheader/is; $result=~s/(\<\/body\>)/$editfooter/is; return $result; } @@ -1069,7 +1095,7 @@ sub handler { } } my %mystyle; - my $result = ''; + my $result = ''; my $filecontents=&Apache::lonnet::getfile($file); if ($filecontents == -1) { $result=(<uri); $request->print($result); return OK; } - + sub debug { if ($Apache::lonxml::debug eq 1) { - print("DEBUG:".$_[0]."
\n"); + $|=1; + print("DEBUG:".join('
',@_)."
\n"); } } sub error { if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { - print "ERROR:".$_[0]."
\n"; + print "ERROR:".join('
',@_)."
\n"; } else { print "An Error occured while processing this resource. The instructor has been notified.
"; #notify author - &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]); + &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_)); #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('
',@_)); } } #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('
',@_)); #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]); } } sub warning { if ($ENV{'request.state'} eq 'construct') { - print "WARNING:".$_[0]."
\n"; + print "WARNING:".join('
',@_)."
\n"; } } @@ -1193,7 +1227,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);