File:  [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.78: download - view: text, annotated - select for diffs
Sat May 26 15:31:33 2001 UTC (23 years ago) by www
Branches: MAIN
CVS tags: HEAD
Start of Simple Edit

    1: # The LearningOnline Network with CAPA
    2: # XML Parser Module 
    3: #
    4: # last modified 06/26/00 by Alexander Sakharuk
    5: # 11/6 Gerd Kortemeyer
    6: # 6/1/1 Gerd Kortemeyer
    7: # 2/21,3/13 Guy
    8: # 3/29,5/4 Gerd Kortemeyer
    9: # 5/10 Scott Harrison
   10: # 5/26 Gerd Kortemeyer
   11: 
   12: package Apache::lonxml; 
   13: use vars 
   14: qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
   15: use strict;
   16: use HTML::TokeParser;
   17: use Safe;
   18: use Safe::Hole;
   19: use Opcode;
   20: 
   21: sub register {
   22:   my $space;
   23:   my @taglist;
   24:   my $temptag;
   25:   ($space,@taglist) = @_;
   26:   foreach $temptag (@taglist) {
   27:     $Apache::lonxml::alltags{$temptag}=$space;
   28:   }
   29: }
   30: 
   31: use Apache::Constants qw(:common);
   32: use Apache::lontexconvert;
   33: use Apache::style;
   34: use Apache::run;
   35: use Apache::londefdef;
   36: use Apache::scripttag;
   37: use Apache::edit;
   38: #==================================================   Main subroutine: xmlparse  
   39: #debugging control, to turn on debugging modify the correct handler
   40: $Apache::lonxml::debug=0;
   41: 
   42: #path to the directory containing the file currently being processed
   43: @pwd=();
   44: 
   45: #these two are used for capturing a subset of the output for later processing,
   46: #don't touch them directly use &startredirection and &endredirection
   47: @outputstack = ();
   48: $redirection = 0;
   49: 
   50: #controls wheter the <import> tag actually does
   51: $import = 1;
   52: @extlinks=();
   53: 
   54: # meta mode is a bit weird only some output is to be turned off
   55: #<output> tag turns metamode off (defined in londefdef.pm)
   56: $metamode = 0;
   57: 
   58: # turns on and of run::evaluate actually derefencing var refs
   59: $evaluate = 1;
   60: 
   61: # data structure for eidt mode, determines what tags can go into what other tags
   62: %insertlist=();
   63: 
   64: #stores the list of active tag namespaces
   65: @namespace=();
   66: 
   67: sub xmlbegin {
   68:   my $output='';
   69:   if ($ENV{'browser.mathml'}) {
   70:       $output='<?xml version="1.0"?>'
   71:             .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
   72:             .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
   73:             .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
   74:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
   75: 		.'xmlns="http://www.w3.org/TR/REC-html40">';
   76:   } else {
   77:       $output='<html>';
   78:   }
   79:   return $output;
   80: }
   81: 
   82: sub xmlend {
   83:     return '</html>';
   84: }
   85: 
   86: sub fontsettings() {
   87:     my $headerstring='';
   88:     if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 
   89:          $headerstring.=
   90:              '<meta Content-Type="text/html; charset=x-mac-roman">';
   91:     }
   92:     return $headerstring;
   93: }
   94: 
   95: sub registerurl {
   96:   return (<<ENDSCRIPT);
   97: <script language="JavaScript">
   98: // BEGIN LON-CAPA Internal
   99:     function LONCAPAreg() {
  100:        if (window.location.pathname!="/res/adm/pages/menu.html") {
  101: 	  menu=window.open("","LONCAPAmenu");
  102: 	  menu.currentURL=window.location.pathname;
  103:           menu.currentStale=0;
  104:        }
  105:     }
  106:   
  107:     function LONCAPAstale() {
  108:        if (window.location.pathname!="/res/adm/pages/menu.html") {
  109: 	  menu=window.open("","LONCAPAmenu");
  110:           menu.currentStale=1;
  111:        }
  112:     }
  113: // END LON-CAPA Internal
  114: </script>
  115: ENDSCRIPT
  116: }
  117: 
  118: sub loadevents() {
  119:     return 'LONCAPAreg();';
  120: }
  121: 
  122: sub unloadevents() {
  123:     return 'LONCAPAstale();';
  124: }
  125: 
  126: sub printalltags {
  127:   my $temp;
  128:   foreach $temp (sort keys %Apache::lonxml::alltags) {
  129:     &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
  130:   }
  131: }
  132: 
  133: sub xmlparse {
  134: 
  135:  my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
  136:  if ($target eq 'meta') {
  137:    $Apache::lonxml::redirection = 0;
  138:    $Apache::lonxml::metamode = 1;
  139:    $Apache::lonxml::evaluate = 1;
  140:    $Apache::lonxml::import = 0;
  141:  } elsif ($target eq 'grade') {
  142:    &startredirection;
  143:    $Apache::lonxml::metamode = 0;
  144:    $Apache::lonxml::evaluate = 1;
  145:    $Apache::lonxml::import = 1;
  146:  } elsif ($target eq 'modified') {
  147:    $Apache::lonxml::redirection = 0;
  148:    $Apache::lonxml::metamode = 0;
  149:    $Apache::lonxml::evaluate = 0;
  150:    $Apache::lonxml::import = 0;
  151:  } else {
  152:    $Apache::lonxml::redirection = 0;
  153:    $Apache::lonxml::metamode = 0;
  154:    $Apache::lonxml::evaluate = 1;
  155:    $Apache::lonxml::import = 1;
  156:  }
  157:  #&printalltags();
  158:  my @pars = ();
  159:  @Apache::lonxml::pwd=();
  160:  my $pwd=$ENV{'request.filename'};
  161:  $pwd =~ s:/[^/]*$::;
  162:  &newparser(\@pars,\$content_file_string,$pwd);
  163:  my $currentstring = '';
  164:  my $finaloutput = ''; 
  165:  my $newarg = '';
  166:  my $result;
  167: 
  168:  my $safeeval = new Safe;
  169:  my $safehole = new Safe::Hole;
  170:  $safeeval->permit("entereval");
  171:  $safeeval->permit(":base_math");
  172:  $safeeval->permit("sort");
  173:  $safeeval->deny(":base_io");
  174:  $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
  175: #need to inspect this class of ops
  176: # $safeeval->deny(":base_orig");
  177:  $safeinit .= ';$external::target='.$target.';';
  178:  $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
  179:  &Apache::run::run($safeinit,$safeeval);
  180: #-------------------- Redefinition of the target in the case of compound target
  181: 
  182:  ($target, my @tenta) = split('&&',$target);
  183: 
  184:  my @stack = (); 
  185:  my @parstack = ();
  186:  &initdepth;
  187:  my $token;
  188:  while ( $#pars > -1 ) {
  189:    while ($token = $pars[$#pars]->get_token) {
  190:      if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
  191:        if ($metamode<1) { $result=$token->[1]; }
  192:      } elsif ($token->[0] eq 'PI') {
  193:        if ($metamode<1) { $result=$token->[2]; }
  194:      } elsif ($token->[0] eq 'S') {
  195:        # add tag to stack 	    
  196:        push (@stack,$token->[1]);
  197:        # add parameters list to another stack
  198:        push (@parstack,&parstring($token));
  199:        &increasedepth($token);       
  200:        if (exists $style_for_target{$token->[1]}) {
  201: 	 if ($Apache::lonxml::redirection) {
  202: 	   $Apache::lonxml::outputstack['-1'] .=  
  203: 	     &recurse($style_for_target{$token->[1]},$target,$safeeval,
  204: 		      \%style_for_target,@parstack);
  205: 	 } else {
  206: 	   $finaloutput .= &recurse($style_for_target{$token->[1]},$target,
  207: 				    $safeeval,\%style_for_target,@parstack);
  208: 	 }
  209:        } else {
  210: 	 $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
  211: 			    \@pars, $safeeval, \%style_for_target);
  212:        }              
  213:      } elsif ($token->[0] eq 'E')  {
  214:        #clear out any tags that didn't end
  215:        while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {
  216: 	 &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
  217: 	 pop @stack;pop @parstack;&decreasedepth($token);
  218:        }
  219:        
  220:        if (exists $style_for_target{'/'."$token->[1]"}) {
  221: 	 if ($Apache::lonxml::redirection) {
  222: 	   $Apache::lonxml::outputstack['-1'] .=  
  223: 	     &recurse($style_for_target{'/'."$token->[1]"},
  224: 		      $target,$safeeval,\%style_for_target,@parstack);
  225: 	 } else {
  226: 	   $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
  227: 				    $target,$safeeval,\%style_for_target,
  228: 				    @parstack);
  229: 	 }
  230: 
  231:        } else {
  232: 	 $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
  233: 			    \@pars,$safeeval, \%style_for_target);
  234:        }
  235:      } else {
  236:        &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
  237:      }
  238:      #evaluate variable refs in result
  239:      if ($result ne "") {
  240:        if ( $#parstack > -1 ) {
  241: 	 if ($Apache::lonxml::redirection) {
  242: 	   $Apache::lonxml::outputstack['-1'] .= 
  243: 	     &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);
  244: 	 } else {
  245: 	   $finaloutput .= &Apache::run::evaluate($result,$safeeval,
  246: 						  $parstack[$#parstack]);
  247: 	 }
  248:        } else {
  249: 	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
  250:        }
  251:        $result = '';
  252:      } 
  253:      if ($token->[0] eq 'E') { 
  254:        pop @stack;pop @parstack;&decreasedepth($token);
  255:      }
  256:    }
  257:    pop @pars;
  258:    pop @Apache::lonxml::pwd;
  259:  }
  260: 
  261: # if ($target eq 'meta') {
  262: #   $finaloutput.=&endredirection;
  263: # }
  264: 
  265:   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
  266:       $finaloutput=&afterburn($finaloutput);
  267:   }
  268: 
  269:  return $finaloutput;
  270: }
  271: 
  272: 
  273: sub recurse {
  274:   
  275:   my @innerstack = (); 
  276:   my @innerparstack = ();
  277:   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
  278:   my @pat = ();
  279:   &newparser(\@pat,\$newarg);
  280:   my $tokenpat;
  281:   my $partstring = '';
  282:   my $output='';
  283:   my $decls='';
  284:   while ( $#pat > -1 ) {
  285:     while  ($tokenpat = $pat[$#pat]->get_token) {
  286:       if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
  287: 	if ($metamode<1) { $partstring=$tokenpat->[1]; }
  288:       } elsif ($tokenpat->[0] eq 'PI') {
  289: 	if ($metamode<1) { $partstring=$tokenpat->[2]; }
  290:       } elsif ($tokenpat->[0] eq 'S') {
  291: 	push (@innerstack,$tokenpat->[1]);
  292: 	push (@innerparstack,&parstring($tokenpat));
  293: 	&increasedepth($tokenpat);
  294: 	$partstring = &callsub("start_$tokenpat->[1]", 
  295: 			       $target, $tokenpat, \@innerparstack,
  296: 			       \@pat, $safeeval, $style_for_target);
  297:       } elsif ($tokenpat->[0] eq 'E') {
  298: 	#clear out any tags that didn't end
  299: 	while ($tokenpat->[1] ne $innerstack[$#innerstack] 
  300: 	       && ($#innerstack > -1)) {
  301: 	  &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
  302: 	  pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);
  303: 	}
  304: 	$partstring = &callsub("end_$tokenpat->[1]",
  305: 			       $target, $tokenpat, \@innerparstack,
  306: 			       \@pat, $safeeval, $style_for_target);
  307:       } else {
  308: 	&Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
  309:       }
  310:       #pass both the variable to the style tag, and the tag we 
  311:       #are processing inside the <definedtag>
  312:       if ( $partstring ne "" ) {
  313: 	if ( $#parstack > -1 ) { 
  314: 	  if ( $#innerparstack > -1 ) { 
  315: 	    $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
  316: 	  } else {
  317: 	    $decls= $parstack[$#parstack];
  318: 	  }
  319: 	} else {
  320: 	  if ( $#innerparstack > -1 ) { 
  321: 	    $decls=$innerparstack[$#innerparstack];
  322: 	  } else {
  323: 	    $decls='';
  324: 	  }
  325: 	}
  326: 	$output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
  327: 	$partstring = '';
  328:       }
  329:       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
  330: 				 &decreasedepth($tokenpat);}
  331:     }
  332:     pop @pat;
  333:     pop @Apache::lonxml::pwd;
  334:   }
  335:   return $output;
  336: }
  337: 
  338: sub callsub {
  339:   my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
  340:   my $currentstring='';
  341:   my $nodefault;
  342:   {
  343:     my $sub1;
  344:     no strict 'refs';
  345:     if ($target eq 'edit' && $token->[0] eq 'S') {
  346:       $currentstring = &Apache::edit::tag_start($target,$token,$parstack,$parser,
  347: 						$safeeval,$style);
  348:     }
  349:     my $tag=$token->[1];
  350:     my $space=$Apache::lonxml::alltags{$tag};
  351:     if (!$space) {
  352: 	$tag=~tr/A-Z/a-z/;
  353: 	$sub=~tr/A-Z/a-z/;
  354: 	$space=$Apache::lonxml::alltags{$tag}
  355:     }
  356:     if ($space) {
  357:       #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
  358:       $sub1="$space\:\:$sub";
  359:       $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
  360:       ($currentstring,$nodefault) = &$sub1($target,$token,$parstack,$parser,
  361: 					   $safeeval,$style);
  362:     } else {
  363:       #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
  364:       if ($metamode <1) {
  365: 	if (defined($token->[4]) && ($metamode < 1)) {
  366: 	  $currentstring = $token->[4];
  367: 	} else {
  368: 	  $currentstring = $token->[2];
  369: 	}
  370:       }
  371:     }
  372:     &Apache::lonxml::debug("nodefalt:$nodefault:");
  373:     if ($currentstring eq '' && $nodefault eq '') {
  374:       if ($target eq 'edit') {
  375: 	&Apache::lonxml::debug("doing default edit for $token->[1]");
  376: 	if ($token->[0] eq 'S') {
  377: 	  $currentstring = &Apache::edit::tag_start($target,$token);
  378: 	} elsif ($token->[0] eq 'E') {
  379: 	  $currentstring = &Apache::edit::tag_end($target,$token);
  380: 	}
  381:       } elsif ($target eq 'modified') {
  382: 	if ($token->[0] eq 'S') {
  383: 	  $currentstring = $token->[4];
  384: 	  $currentstring.=&Apache::edit::handle_insert();
  385: 	} else {
  386: 	  $currentstring = $token->[2];
  387: 	}
  388:       }
  389:     }
  390:     use strict 'refs';
  391:   }
  392:   return $currentstring;
  393: }
  394: 
  395: sub startredirection {
  396:   $Apache::lonxml::redirection++;
  397:   push (@Apache::lonxml::outputstack, '');
  398: }
  399: 
  400: sub endredirection {
  401:   if (!$Apache::lonxml::redirection) {
  402:     &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
  403:     return '';
  404:   }
  405:   $Apache::lonxml::redirection--;
  406:   pop @Apache::lonxml::outputstack;
  407: }
  408: 
  409: sub initdepth {
  410:   @Apache::lonxml::depthcounter=();
  411:   $Apache::lonxml::depth=-1;
  412:   $Apache::lonxml::olddepth=-1;
  413: }
  414: 
  415: sub increasedepth {
  416:   my ($token) = @_;
  417:   $Apache::lonxml::depth++;
  418:   $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
  419:   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
  420:     $Apache::lonxml::olddepth=$Apache::lonxml::depth;
  421:   }
  422:   my $curdepth=join('_',@Apache::lonxml::depthcounter);
  423:   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
  424: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
  425: }
  426: 
  427: sub decreasedepth {
  428:   my ($token) = @_;
  429:   $Apache::lonxml::depth--;
  430:   if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
  431:     $#Apache::lonxml::depthcounter--;
  432:     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
  433:   }
  434:   if (  $Apache::lonxml::depth < -1) {
  435:     &Apache::lonxml::warning("Unbalanced tags in resource");   
  436:     $Apache::lonxml::depth='-1';
  437:   }
  438:   my $curdepth=join('_',@Apache::lonxml::depthcounter);
  439:   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
  440: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
  441: }
  442: 
  443: sub get_all_text {
  444: 
  445:  my($tag,$pars)= @_;
  446:  my $depth=0;
  447:  my $token;
  448:  my $result='';
  449:  if ( $tag =~ m:^/: ) { 
  450:    my $tag=substr($tag,1); 
  451: #   &Apache::lonxml::debug("have:$tag:");
  452:    while (($depth >=0) && ($token = $pars->get_token)) {
  453: #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
  454:      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
  455:        $result.=$token->[1];
  456:      } elsif ($token->[0] eq 'PI') {
  457:        $result.=$token->[2];
  458:      } elsif ($token->[0] eq 'S') {
  459:        if ($token->[1] eq $tag) { $depth++; }
  460:        $result.=$token->[4];
  461:      } elsif ($token->[0] eq 'E')  {
  462:        if ( $token->[1] eq $tag) { $depth--; }
  463:        #skip sending back the last end tag
  464:        if ($depth > -1) { $result.=$token->[2]; } else {
  465: 	 $pars->unget_token($token);
  466:        }
  467:      }
  468:    }
  469:  } else {
  470:    while ($token = $pars->get_token) {
  471: #     &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
  472:      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
  473:        $result.=$token->[1];
  474:      } elsif ($token->[0] eq 'PI') {
  475:        $result.=$token->[2];
  476:      } elsif ($token->[0] eq 'S') {
  477:        if ( $token->[1] eq $tag) { 
  478: 	 $pars->unget_token($token); last;
  479:        } else {
  480: 	 $result.=$token->[4];
  481:        }
  482:      } elsif ($token->[0] eq 'E')  {
  483:        $result.=$token->[2];
  484:      }
  485:    }
  486:  }
  487: # &Apache::lonxml::debug("Exit:$result:");
  488:  return $result
  489: }
  490: 
  491: sub newparser {
  492:   my ($parser,$contentref,$dir) = @_;
  493:   push (@$parser,HTML::TokeParser->new($contentref));
  494:   $$parser['-1']->xml_mode('1');
  495:   if ( $dir eq '' ) {
  496:     push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
  497:   } else {
  498:     push (@Apache::lonxml::pwd, $dir);
  499:   } 
  500: #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
  501: #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
  502: }
  503: 
  504: sub parstring {
  505:   my ($token) = @_;
  506:   my $temp='';
  507:   map {
  508:     unless ($_=~/\W/) {
  509:       my $val=$token->[2]->{$_};
  510:       $val =~ s/([\%\@\\])/\\$1/g;
  511:       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
  512:       $temp .= "my \$$_=\"$val\";"
  513:     }
  514:   } @{$token->[3]};
  515:   return $temp;
  516: }
  517: 
  518: sub writeallows {
  519:     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
  520:     my $thisdir=$thisurl;
  521:     $thisdir=~s/\/[^\/]+$//;
  522:     my %httpref=();
  523:     map {
  524:        $httpref{'httpref.'.
  525:  	        &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;
  526:     &Apache::lonnet::appenv(%httpref);
  527: }
  528: 
  529: #
  530: # Afterburner handles anchors, highlights and links
  531: #
  532: sub afterburn {
  533:     my $result=shift;
  534:     map {
  535:        my ($name, $value) = split(/=/,$_);
  536:        $value =~ tr/+/ /;
  537:        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  538:        if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
  539:            unless ($ENV{'form.'.$name}) {
  540:               $ENV{'form.'.$name}=$value;
  541: 	   }
  542:        }
  543:     } (split(/&/,$ENV{'QUERY_STRING'}));
  544:     if ($ENV{'form.highlight'}) {
  545:         map {
  546:            my $anchorname=$_;
  547: 	   my $matchthis=$anchorname;
  548:            $matchthis=~s/\_+/\\s\+/g;
  549:            $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
  550:        } split(/\,/,$ENV{'form.highlight'});
  551:     }
  552:     if ($ENV{'form.link'}) {
  553:         map {
  554:            my ($anchorname,$linkurl)=split(/\>/,$_);
  555: 	   my $matchthis=$anchorname;
  556:            $matchthis=~s/\_+/\\s\+/g;
  557:            $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
  558:        } split(/\,/,$ENV{'form.link'});
  559:     }
  560:     if ($ENV{'form.anchor'}) {
  561:         my $anchorname=$ENV{'form.anchor'};
  562: 	my $matchthis=$anchorname;
  563:         $matchthis=~s/\_+/\\s\+/g;
  564:         $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
  565:         $result.=(<<"ENDSCRIPT");
  566: <script>
  567:     document.location.hash='$anchorname';
  568: </script>
  569: ENDSCRIPT
  570:     }
  571:     return $result;
  572: }
  573: 
  574: sub inserteditinfo {
  575:       my ($result,$filecontents)=@_;
  576:       unless ($filecontents) {
  577: 	  $filecontents=(<<SIMPLECONTENT);
  578: <html>
  579: <head>
  580: <title>
  581:                            Title of Document Goes Here
  582: </title>
  583: </head>
  584: <body bgcolor="#FFFFFF">
  585: 
  586:                            Body of Document Goes Here
  587: 
  588: </body>
  589: </html>
  590: SIMPLECONTENT
  591:       }
  592:       my $editheader='<a href="#editsection">Edit below</a><hr />';
  593:       my $editfooter=(<<ENDFOOTER);
  594: <hr />
  595: <a name="editsection" />
  596: <form method="post">
  597: <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
  598: <br />
  599: <input type="submit" name="savethisfile" value="Save this file" />
  600: </form>
  601: ENDFOOTER
  602:       $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
  603:       $result=~s/(\<\/body\>)/$editfooter/is;
  604:       return $result;
  605: }
  606: 
  607: sub handler {
  608:   my $request=shift;
  609: 
  610:   my $target='web';
  611: 
  612:   $Apache::lonxml::debug=0;
  613: 
  614:   if ($ENV{'browser.mathml'}) {
  615:     $request->content_type('text/xml');
  616:   } else {
  617:     $request->content_type('text/html');
  618:   }
  619:   
  620:   $request->send_http_header;
  621:   
  622:   return OK if $request->header_only;
  623: 
  624: #
  625: # Edit action? Save file.
  626: #
  627:   unless ($ENV{'request.state'} eq 'published') {
  628:       if ($ENV{'form.savethisfile'}) {
  629: 
  630:       }
  631:   }
  632: 
  633:   my $file=&Apache::lonnet::filelocation("",$request->uri);
  634:   my %mystyle;
  635:   my $result = ''; 
  636:   my $filecontents=&Apache::lonnet::getfile($file);
  637:   if ($filecontents == -1) {
  638:     $result=(<<ENDNOTFOUND);
  639: <html>
  640: <head>
  641: <title>File not found</title>
  642: </head>
  643: <body bgcolor="#FFFFFF">
  644: <b>File not found: $file</b>
  645: </body>
  646: </html>
  647: ENDNOTFOUND
  648:     $filecontents='';
  649:   } else {
  650:     $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
  651:   }
  652: 
  653: #
  654: # Edit action? Insert editing commands
  655: #
  656:   unless ($ENV{'request.state'} eq 'published') {
  657:       $result=&inserteditinfo($result,$filecontents);
  658:   }
  659: 
  660:   $request->print($result);
  661: 
  662:   writeallows($request->uri);
  663:   return OK;
  664: }
  665:  
  666: sub debug {
  667:   if ($Apache::lonxml::debug eq 1) {
  668:     print "DEBUG:".$_[0]."<br />\n";
  669:   }
  670: }
  671: 
  672: sub error {
  673:   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
  674:     print "<b>ERROR:</b>".$_[0]."<br />\n";
  675:   } else {
  676:     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
  677:     #notify author
  678:     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
  679:     #notify course
  680:     if ( $ENV{'request.course.id'} ) {
  681:       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
  682:       foreach my $user (split /\,/, $users) {
  683: 	($user,my $domain) = split /:/, $user;
  684: 	&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
  685:       }
  686:     }
  687: 
  688:     #FIXME probably shouldn't have me get everything forever.
  689:     &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
  690:     #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
  691:   }
  692: }
  693: 
  694: sub warning {
  695:   if ($ENV{'request.state'} eq 'construct') {
  696:     print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
  697:   }
  698: }
  699: 
  700: sub register_insert {
  701:   my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
  702:   my $i;
  703:   my $tagnum=0;
  704:   my @order;
  705:   for ($i=0;$i < $#data; $i++) {
  706:     my $line = $data[$i];
  707:     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
  708:     if ( $line =~ /TABLE/ ) { last; }
  709:     my ($tag,$descrip,$function,$show) = split(/,/, $line);
  710:     $insertlist{"$tagnum.tag"} = $tag;
  711:     $insertlist{"$tagnum.description"} = $descrip;
  712:     $insertlist{"$tagnum.function"} = $function;
  713:     $insertlist{"$tagnum.show"}= $show;
  714:     $tagnum++;
  715:   }
  716:   $i++; #skipping TABLE line
  717:   $tagnum = 0;
  718:   for (;$i < $#data;$i++) {
  719:     my $line = $data[$i];
  720:     my ($mnemonic,@which) = split(/ +/,$line);
  721:     my $tag = $insertlist{"$tagnum.tag"};
  722:     for (my $j=0;$j <$#which;$j++) {
  723:       if ( $which[$j] eq 'Y' ) {
  724: 	if ($insertlist{"$j.show"} ne 'no') {
  725: 	  push(@{ $insertlist{"$tag.which"} },$j);
  726: 	}
  727:       }
  728:     }
  729:     $tagnum++;
  730:   }
  731: }
  732: 1;
  733: __END__
  734: 
  735: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>