--- loncom/xml/lonxml.pm 2001/08/16 11:25:03 1.116 +++ loncom/xml/lonxml.pm 2001/11/29 21:38:17 1.140 @@ -1,6 +1,41 @@ # The LearningOnline Network with CAPA # XML Parser Module # +# $Id: lonxml.pm,v 1.140 2001/11/29 21:38:17 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# Copyright for TtHfunc and TtMfunc by Ian Hutchinson. +# TtHfunc and TtMfunc (the "Code") may be compiled and linked into +# binary executable programs or libraries distributed by the +# Michigan State University (the "Licensee"), but any binaries so +# distributed are hereby licensed only for use in the context +# of a program or computational system for which the Licensee is the +# primary author or distributor, and which performs substantial +# additional tasks beyond the translation of (La)TeX into HTML. +# The C source of the Code may not be distributed by the Licensee +# to any other parties under any circumstances. +# # last modified 06/26/00 by Alexander Sakharuk # 11/6 Gerd Kortemeyer # 6/1/1 Gerd Kortemeyer @@ -13,7 +48,10 @@ # 6/12,6/13 H. K. Ng # 6/16 Gerd Kortemeyer # 7/27 H. K. Ng -# 8/7,8/9,8/10,8/11,8/15,8/16 Gerd Kortemeyer +# 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 + package Apache::lonxml; use vars @@ -46,6 +84,7 @@ use Apache::scripttag; use Apache::edit; use Apache::lonnet; use Apache::File; +use Apache::loncommon; #================================================== Main subroutine: xmlparse #debugging control, to turn on debugging modify the correct handler @@ -152,8 +191,57 @@ sub xmlend { return $discussion.''; } +sub tokeninputfield { + my $defhost=$Apache::lonnet::perlvar{'lonHostID'}; + $defhost=~tr/a-z/A-Z/; + return (< + function updatetoken() { + var comp=new Array; + var barcode=unescape(document.tokeninput.barcode.value); + comp=barcode.split('*'); + if (typeof(comp[0])!="undefined") { + document.tokeninput.codeone.value=comp[0]; + } + if (typeof(comp[1])!="undefined") { + document.tokeninput.codetwo.value=comp[1]; + } + if (typeof(comp[2])!="undefined") { + comp[2]=comp[2].toUpperCase(); + document.tokeninput.codethree.value=comp[2]; + } + document.tokeninput.barcode.value=''; + } + +
+ + + + +
DocID Checkin
+ + + + + + + +
Scan in Barcode
or Type in DocID + +* + +* + +
+
+
+ENDINPUTFIELD +} + sub maketoken { - my ($target,$symb,$tuname,$tudom,$tcrsid)=@_; + my ($symb,$tuname,$tudom,$tcrsid)=@_; unless ($symb) { $symb=&Apache::lonnet::symbread(); } @@ -163,10 +251,23 @@ sub maketoken { $tcrsid=$ENV{'request.course.id'}; } - my $token=&Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid); - + return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid); +} + +sub printtokenheader { + my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; unless ($token) { return ''; } + my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + unless ($tsymb) { + $tsymb=$symb; + } + unless ($tuname) { + $tuname=$name; + $tudom=$domain; + $tcrsid=$courseid; + } + my %reply=&Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation'], $tudom,$tuname); @@ -180,11 +281,11 @@ sub maketoken { ''. 'Checked out for '.$plainname. '
User: '.$tuname.' at '.$tudom. - '
CourseID: '.$tcrsid.')'. + '
CourseID: '.$tcrsid. '
DocID: '.$token. '
Time: '.localtime().'
'; } else { - return $token; + return $token; } } @@ -199,7 +300,11 @@ sub fontsettings() { sub registerurl { my $forcereg=shift; - if ($Apache::lonxml::registered) { return ''; } + if ($ENV{'request.publicaccess'}) { + return + ''; + } + if ($Apache::lonxml::registered && !$forcereg) { return ''; } $Apache::lonxml::registered=1; if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) { my $hwkadd=''; @@ -262,7 +367,7 @@ ENDPARM menu=window.open("","LONCAPAmenu"); menu.currentStale=1; menu.switchbutton - (3,1,'reload.gif','return','location','go(currentURL)'); + (3,1,'reload.gif','return','location','go(currentURL)'); menu.clearbut(7,1); menu.clearbut(7,2); menu.clearbut(7,3); @@ -347,7 +452,9 @@ sub xmlparse { my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, $safeeval,\%style_for_target); - + if ($ENV{'request.uri'}) { + &writeallows($ENV{'request.uri'}); + } return $finaloutput; } @@ -356,11 +463,11 @@ sub htmlclean { my $tree = HTML::TreeBuilder->new; $tree->ignore_unknown(0); - + $tree->parse($raw); my $output= $tree->as_HTML(undef,' '); - + $output=~s/\<(br|hr|img|meta|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis; $output=~s/\<\/(br|hr|img|meta|allow)\>//gis; unless ($full) { @@ -374,7 +481,6 @@ sub htmlclean { sub inner_xmlparse { my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_; - &Apache::lonxml::debug('Reentrant parser starting, again?'); my $finaloutput = ''; my $result; my $token; @@ -389,14 +495,14 @@ sub inner_xmlparse { $result=$token->[2]; } } elsif ($token->[0] eq 'S') { - # add tag to stack + # add tag to stack push (@$stack,$token->[1]); # add parameters list to another stack push (@$parstack,&parstring($token)); - &increasedepth($token); + &increasedepth($token); if (exists $$style_for_target{$token->[1]}) { if ($Apache::lonxml::redirection) { - $Apache::lonxml::outputstack['-1'] .= + $Apache::lonxml::outputstack['-1'] .= &recurse($$style_for_target{$token->[1]},$target,$safeeval, $style_for_target,@$parstack); } else { @@ -406,15 +512,15 @@ sub inner_xmlparse { } else { $result = &callsub("start_$token->[1]", $target, $token, $stack, $parstack, $pars, $safeeval, $style_for_target); - } + } } elsif ($token->[0] eq 'E') { #clear out any tags that didn't end while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { - &Apache::lonxml::warning("Unbalanced tags in resource $$stack['-1']"); + &Apache::lonxml::warning('Missing tag </'.$$stack['-1'].'> in file'); &end_tag($stack,$parstack,$token); } - - if (exists $$style_for_target{'/'."$token->[1]"}) { + + if (exists($$style_for_target{'/'."$token->[1]"})) { if ($Apache::lonxml::redirection) { $Apache::lonxml::outputstack['-1'] .= &recurse($$style_for_target{'/'."$token->[1]"}, @@ -424,7 +530,6 @@ sub inner_xmlparse { $target,$safeeval,$style_for_target, @$parstack); } - } else { $result = &callsub("end_$token->[1]", $target, $token, $stack, $parstack, $pars,$safeeval, $style_for_target); @@ -475,6 +580,7 @@ sub recurse { my $partstring = ''; my $output=''; my $decls=''; + &Apache::lonxml::debug("Recursing"); while ( $#pat > -1 ) { while ($tokenpat = $pat[$#pat]->get_token) { if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) { @@ -492,7 +598,7 @@ sub recurse { #clear out any tags that didn't end while ($tokenpat->[1] ne $innerstack[$#innerstack] && ($#innerstack > -1)) { - &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']"); + &Apache::lonxml::warning('Missing tag </'.$innerstack['-1'].'> in style'); &end_tag(\@innerstack,\@innerparstack,$tokenpat); } $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, @@ -526,6 +632,7 @@ sub recurse { pop @pat; pop @Apache::lonxml::pwd; } + &Apache::lonxml::debug("Exiting Recursing"); return $output; } @@ -596,11 +703,17 @@ sub setup_globals { my ($target)=@_; $Apache::lonxml::registered = 0; @Apache::lonxml::pwd=(); + @Apache::lonxml::extlinks=(); if ($target eq 'meta') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 0; + } elsif ($target eq 'answer') { + $Apache::lonxml::redirection = 0; + $Apache::lonxml::metamode = 1; + $Apache::lonxml::evaluate = 1; + $Apache::lonxml::import = 1; } elsif ($target eq 'grade') { &startredirection; $Apache::lonxml::metamode = 0; @@ -677,7 +790,10 @@ sub init_safespace { #need to inspect this class of ops # $safeeval->deny(":base_orig"); $safeinit .= ';$external::target="'.$target.'";'; - $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';'; + my $rndseed; + my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name); + $safeinit .= ';$external::randomseed='.$rndseed.';'; &Apache::run::run($safeinit,$safeeval); } @@ -728,7 +844,7 @@ sub decreasedepth { $Apache::lonxml::olddepth=$Apache::lonxml::depth+1; } if ( $Apache::lonxml::depth < -1) { - &Apache::lonxml::warning("Unbalanced tags in resource"); + &Apache::lonxml::warning("Missing tags, unable to properly run file."); $Apache::lonxml::depth='-1'; } my $curdepth=join('_',@Apache::lonxml::depthcounter); @@ -812,6 +928,7 @@ sub parstring { } sub writeallows { + unless ($#extlinks>=0) { return; } my $thisurl='/res/'.&Apache::lonnet::declutter(shift); if ($ENV{'httpref.'.$thisurl}) { $thisurl=$ENV{'httpref.'.$thisurl}; @@ -821,7 +938,9 @@ sub writeallows { my %httpref=(); map { $httpref{'httpref.'. - &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks; + &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; + } @extlinks; + @extlinks=(); &Apache::lonnet::appenv(%httpref); } @@ -925,7 +1044,7 @@ sub handler { } else { $request->content_type('text/html'); } - + &Apache::loncommon::no_cache($request); $request->send_http_header; return OK if $request->header_only; @@ -970,10 +1089,11 @@ ENDNOTFOUND unless ($ENV{'request.state'} eq 'published') { $result=&inserteditinfo($result,$filecontents); } + + writeallows($request->uri); $request->print($result); - writeallows($request->uri); return OK; } @@ -1016,7 +1136,25 @@ sub get_param { if ( ! $context ) { $context = -1; } my $args =''; if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } - return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' + if ( $args =~ /my \$$param=\"/ ) { + return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' + } else { + return undef; + } +} + +sub get_param_var { + my ($param,$parstack,$safeeval,$context) = @_; + if ( ! $context ) { $context = -1; } + my $args =''; + if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } + if ( $args !~ /my \$$param=\"/ ) { return undef; } + my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' + if ($value =~ /^[\$\@\%]/) { + return &Apache::run::run("return $value",$safeeval,1); + } else { + return $value; + } } sub register_insert { @@ -1029,13 +1167,16 @@ sub register_insert { if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; } if ( $line =~ /TABLE/ ) { last; } my ($tag,$descrip,$color,$function,$show) = split(/,/, $line); - $insertlist{"$tagnum.tag"} = $tag; - $insertlist{"$tagnum.description"} = $descrip; - $insertlist{"$tagnum.color"} = $color; - $insertlist{"$tagnum.function"} = $function; - $insertlist{"$tagnum.show"}= $show; - $insertlist{"$tag.num"}=$tagnum; - $tagnum++; + if ($tag) { + $insertlist{"$tagnum.tag"} = $tag; + $insertlist{"$tagnum.description"} = $descrip; + $insertlist{"$tagnum.color"} = $color; + $insertlist{"$tagnum.function"} = $function; + if (!defined($show)) { $show='yes'; } + $insertlist{"$tagnum.show"}= $show; + $insertlist{"$tag.num"}=$tagnum; + $tagnum++; + } } $i++; #skipping TABLE line $tagnum = 0; @@ -1056,8 +1197,41 @@ sub register_insert { sub description { my ($token)=@_; - return $insertlist{$insertlist{"$token->[1].num"}.'.description'}; + my $tagnum; + my $tag=$token->[1]; + foreach my $namespace (reverse @Apache::lonxml::namespace) { + my $testtag=$namespace.'::'.$tag; + $tagnum=$insertlist{"$testtag.num"}; + if (defined($tagnum)) { last; } + } + if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } + return $insertlist{$tagnum.'.description'}; +} + +# ----------------------------------------------------------------- whichuser +# returns a list of $symb, $courseid, $domain, $name that is correct for +# calls to lonnet functions for this setup. +# - looks for form.grade_ parameters +sub whichuser { + my ($symb,$courseid,$domain,$name); + if (defined($ENV{'form.grade_symb'})) { + my $tmp_courseid=$ENV{'form.grade_courseid'}; + my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid); + if ($allowed) { + $symb=$ENV{'form.grade_symb'}; + $courseid=$ENV{'form.grade_courseid'}; + $domain=$ENV{'form.grade_domain'}; + $name=$ENV{'form.grade_username'}; + } + } else { + $symb=&Apache::lonnet::symbread(); + $courseid=$ENV{'request.course.id'}; + $domain=$ENV{'user.domain'}; + $name=$ENV{'user.name'}; + } + return ($symb,$courseid,$domain,$name); } + 1; __END__