Annotation of loncom/xml/lonxml.pm, revision 1.97

1.2       sakharuk    1: # The LearningOnline Network with CAPA
1.3       sakharuk    2: # XML Parser Module 
1.2       sakharuk    3: #
1.3       sakharuk    4: # last modified 06/26/00 by Alexander Sakharuk
1.33      www         5: # 11/6 Gerd Kortemeyer
1.45      www         6: # 6/1/1 Gerd Kortemeyer
1.56      albertel    7: # 2/21,3/13 Guy
1.68      www         8: # 3/29,5/4 Gerd Kortemeyer
1.73      harris41    9: # 5/10 Scott Harrison
1.78      www        10: # 5/26 Gerd Kortemeyer
1.80      harris41   11: # 5/27 H. K. Ng
1.89      www        12: # 6/2,6/3,6/8,6/9 Gerd Kortemeyer
1.93      ng         13: # 6/12,6/13 H. K. Ng
1.95      www        14: # 6/16 Gerd Kortemeyer
1.2       sakharuk   15: 
1.4       albertel   16: package Apache::lonxml; 
1.33      www        17: use vars 
1.76      albertel   18: qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
1.1       sakharuk   19: use strict;
                     20: use HTML::TokeParser;
1.3       sakharuk   21: use Safe;
1.40      albertel   22: use Safe::Hole;
1.81      ng         23: use Math::Cephes qw(:trigs :hypers :bessels erf erfc);
1.91      ng         24: use Math::Random qw(:all);
1.13      albertel   25: use Opcode;
1.72      albertel   26: 
                     27: sub register {
                     28:   my $space;
                     29:   my @taglist;
                     30:   my $temptag;
                     31:   ($space,@taglist) = @_;
                     32:   foreach $temptag (@taglist) {
                     33:     $Apache::lonxml::alltags{$temptag}=$space;
                     34:   }
                     35: }
                     36: 
1.46      www        37: use Apache::Constants qw(:common);
1.71      www        38: use Apache::lontexconvert;
1.72      albertel   39: use Apache::style;
                     40: use Apache::run;
                     41: use Apache::londefdef;
                     42: use Apache::scripttag;
                     43: use Apache::edit;
1.79      www        44: use Apache::lonnet;
                     45: use Apache::File;
                     46: 
1.72      albertel   47: #==================================================   Main subroutine: xmlparse  
                     48: #debugging control, to turn on debugging modify the correct handler
                     49: $Apache::lonxml::debug=0;
                     50: 
                     51: #path to the directory containing the file currently being processed
                     52: @pwd=();
                     53: 
                     54: #these two are used for capturing a subset of the output for later processing,
                     55: #don't touch them directly use &startredirection and &endredirection
                     56: @outputstack = ();
                     57: $redirection = 0;
                     58: 
                     59: #controls wheter the <import> tag actually does
                     60: $import = 1;
                     61: @extlinks=();
                     62: 
                     63: # meta mode is a bit weird only some output is to be turned off
                     64: #<output> tag turns metamode off (defined in londefdef.pm)
                     65: $metamode = 0;
                     66: 
                     67: # turns on and of run::evaluate actually derefencing var refs
                     68: $evaluate = 1;
1.7       albertel   69: 
1.74      albertel   70: # data structure for eidt mode, determines what tags can go into what other tags
                     71: %insertlist=();
1.68      www        72: 
1.76      albertel   73: #stores the list of active tag namespaces
                     74: @namespace=();
                     75: 
1.68      www        76: sub xmlbegin {
                     77:   my $output='';
                     78:   if ($ENV{'browser.mathml'}) {
                     79:       $output='<?xml version="1.0"?>'
                     80:             .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
                     81:             .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                     82:             .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
                     83:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                     84: 		.'xmlns="http://www.w3.org/TR/REC-html40">';
                     85:   } else {
                     86:       $output='<html>';
                     87:   }
                     88:   return $output;
                     89: }
                     90: 
                     91: sub xmlend {
                     92:     return '</html>';
                     93: }
                     94: 
1.70      www        95: sub fontsettings() {
                     96:     my $headerstring='';
                     97:     if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 
                     98:          $headerstring.=
                     99:              '<meta Content-Type="text/html; charset=x-mac-roman">';
                    100:     }
                    101:     return $headerstring;
                    102: }
                    103: 
1.68      www       104: sub registerurl {
1.86      www       105:     if ($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) {
1.87      www       106:         my $hwkadd='';
                    107:         if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                    108: 	    if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
                    109: 		$hwkadd.=(<<ENDSUBM);
                    110:                      menu.switchbutton
                    111:            (7,1,'subm.gif','view sub','missions',
1.88      www       112:                 'gocmd("/adm/grades","submission")');
1.87      www       113: ENDSUBM
                    114:             }
                    115: 	    if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
                    116: 		$hwkadd.=(<<ENDGRDS);
                    117:                      menu.switchbutton
                    118:            (7,2,'pgrd.gif','problem','grades',
1.88      www       119:                 'gocmd("/adm/grades","viewgrades")');
1.87      www       120: ENDGRDS
                    121:             }
                    122: 	    if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
                    123: 		$hwkadd.=(<<ENDPARM);
                    124:                      menu.switchbutton
                    125:            (7,3,'pparm.gif','problem','parms',
1.88      www       126:                 'gocmd("/adm/parmset","set")');
1.87      www       127: ENDPARM
                    128:             }
                    129: 	}
1.86      www       130: 	return (<<ENDREGTHIS);
1.87      www       131:      
1.68      www       132: <script language="JavaScript">
1.71      www       133: // BEGIN LON-CAPA Internal
1.86      www       134: 
1.69      www       135:     function LONCAPAreg() {
                    136: 	  menu=window.open("","LONCAPAmenu");
1.86      www       137:           menu.clearTimeout(menu.menucltim);
1.69      www       138: 	  menu.currentURL=window.location.pathname;
                    139:           menu.currentStale=0;
1.85      www       140:           menu.clearbut(3,1);
                    141:           menu.switchbutton
                    142:        (8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)');
                    143:           menu.switchbutton
                    144:     (8,2,'fdbk.gif','feedback','on this','gopost("/adm/feedback",currentURL)');
                    145:           menu.switchbutton
                    146:      (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)');
                    147:           menu.switchbutton
                    148:        (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)');
                    149:           menu.switchbutton
                    150:      (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)');
1.94      www       151:           menu.switchbutton
                    152:                             (9,1,'sbkm.gif','set','bookmark','set_bookmark()');
                    153:           menu.switchbutton
                    154:                          (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()');
                    155:           menu.switchbutton
1.95      www       156:                                (9,3,'anot.gif','anno-','tations','annotate()');
1.87      www       157:           $hwkadd
1.69      www       158:     }
1.86      www       159: 
1.69      www       160:     function LONCAPAstale() {
1.86      www       161: 	  menu=window.open("","LONCAPAmenu");
                    162:           menu.currentStale=1;
                    163:           menu.switchbutton
                    164:             (3,1,'reload.gif','return','location','go(currentURL)');
1.90      www       165:           menu.clearbut(7,1);
                    166:           menu.clearbut(7,2);
                    167:           menu.clearbut(7,3);
1.86      www       168:           menu.menucltim=menu.setTimeout(
1.94      www       169:  'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
                    170:  'clearbut(9,1);clearbut(9,2);clearbut(9,3);',
1.86      www       171: 			  2000);
                    172: 
1.87      www       173:       }
1.86      www       174: 
                    175: // END LON-CAPA Internal
                    176: </script>
                    177: ENDREGTHIS
                    178: 
                    179:     } else {
                    180:         return (<<ENDDONOTREGTHIS);
                    181: 
                    182: <script language="JavaScript">
                    183: // BEGIN LON-CAPA Internal
                    184: 
                    185:     function LONCAPAreg() {
1.69      www       186: 	  menu=window.open("","LONCAPAmenu");
                    187:           menu.currentStale=1;
1.85      www       188:           menu.clearbut(2,1);
                    189:           menu.clearbut(2,3);
                    190:           menu.clearbut(8,1);
                    191:           menu.clearbut(8,2);
                    192:           menu.clearbut(8,3);
1.86      www       193:           if (menu.currentURL) {
                    194:              menu.switchbutton
                    195:               (3,1,'reload.gif','return','location','go(currentURL)');
                    196:  	  } else {
                    197: 	      menu.clearbut(3,1);
                    198:           }
                    199:     }
                    200: 
                    201:     function LONCAPAstale() {
1.68      www       202:     }
1.86      www       203: 
1.71      www       204: // END LON-CAPA Internal
1.68      www       205: </script>
1.86      www       206: ENDDONOTREGTHIS
                    207: 
                    208:     }
1.69      www       209: }
                    210: 
                    211: sub loadevents() {
                    212:     return 'LONCAPAreg();';
                    213: }
                    214: 
                    215: sub unloadevents() {
                    216:     return 'LONCAPAstale();';
1.68      www       217: }
                    218: 
1.48      albertel  219: sub printalltags {
                    220:   my $temp;
                    221:   foreach $temp (sort keys %Apache::lonxml::alltags) {
1.64      albertel  222:     &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
1.48      albertel  223:   }
                    224: }
1.31      sakharuk  225: 
1.3       sakharuk  226: sub xmlparse {
1.18      albertel  227:  my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
1.96      albertel  228: 
                    229:  &setup_globals($target);
1.48      albertel  230:  #&printalltags();
1.16      albertel  231:  my @pars = ();
1.23      albertel  232:  @Apache::lonxml::pwd=();
                    233:  my $pwd=$ENV{'request.filename'};
                    234:  $pwd =~ s:/[^/]*$::;
                    235:  &newparser(\@pars,\$content_file_string,$pwd);
1.3       sakharuk  236:  my $currentstring = '';
                    237:  my $finaloutput = ''; 
                    238:  my $newarg = '';
1.16      albertel  239:  my $result;
1.24      sakharuk  240: 
1.3       sakharuk  241:  my $safeeval = new Safe;
1.40      albertel  242:  my $safehole = new Safe::Hole;
1.82      ng        243:  &init_safespace($target,$safeeval,$safehole,$safeinit);
1.3       sakharuk  244: #-------------------- Redefinition of the target in the case of compound target
                    245: 
                    246:  ($target, my @tenta) = split('&&',$target);
                    247: 
                    248:  my @stack = (); 
                    249:  my @parstack = ();
1.17      albertel  250:  &initdepth;
1.3       sakharuk  251:  my $token;
1.16      albertel  252:  while ( $#pars > -1 ) {
                    253:    while ($token = $pars[$#pars]->get_token) {
1.57      albertel  254:      if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
1.61      albertel  255:        if ($metamode<1) { $result=$token->[1]; }
1.57      albertel  256:      } elsif ($token->[0] eq 'PI') {
1.61      albertel  257:        if ($metamode<1) { $result=$token->[2]; }
1.16      albertel  258:      } elsif ($token->[0] eq 'S') {
                    259:        # add tag to stack 	    
                    260:        push (@stack,$token->[1]);
                    261:        # add parameters list to another stack
                    262:        push (@parstack,&parstring($token));
1.19      albertel  263:        &increasedepth($token);       
1.16      albertel  264:        if (exists $style_for_target{$token->[1]}) {
1.61      albertel  265: 	 if ($Apache::lonxml::redirection) {
1.55      albertel  266: 	   $Apache::lonxml::outputstack['-1'] .=  
                    267: 	     &recurse($style_for_target{$token->[1]},$target,$safeeval,
                    268: 		      \%style_for_target,@parstack);
1.41      albertel  269: 	 } else {
1.55      albertel  270: 	   $finaloutput .= &recurse($style_for_target{$token->[1]},$target,
                    271: 				    $safeeval,\%style_for_target,@parstack);
1.41      albertel  272: 	 }
1.16      albertel  273:        } else {
1.84      albertel  274: 	 $result = &callsub("start_$token->[1]", $target, $token, \@stack,
                    275: 			    \@parstack, \@pars, $safeeval, \%style_for_target);
1.16      albertel  276:        }              
                    277:      } elsif ($token->[0] eq 'E')  {
                    278:        #clear out any tags that didn't end
1.55      albertel  279:        while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {
                    280: 	 &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
1.97    ! albertel  281: 	 &end_tag(\@stack,\@parstack,$token);
1.43      albertel  282:        }
1.16      albertel  283:        
                    284:        if (exists $style_for_target{'/'."$token->[1]"}) {
1.61      albertel  285: 	 if ($Apache::lonxml::redirection) {
1.55      albertel  286: 	   $Apache::lonxml::outputstack['-1'] .=  
                    287: 	     &recurse($style_for_target{'/'."$token->[1]"},
                    288: 		      $target,$safeeval,\%style_for_target,@parstack);
                    289: 	 } else {
                    290: 	   $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
                    291: 				    $target,$safeeval,\%style_for_target,
                    292: 				    @parstack);
                    293: 	 }
1.59      albertel  294: 
1.16      albertel  295:        } else {
1.84      albertel  296: 	 $result = &callsub("end_$token->[1]", $target, $token, \@stack, 
                    297: 			    \@parstack, \@pars,$safeeval, \%style_for_target);
1.13      albertel  298:        }
1.57      albertel  299:      } else {
                    300:        &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
1.16      albertel  301:      }
1.55      albertel  302:      #evaluate variable refs in result
1.25      sakharuk  303:      if ($result ne "") {
1.24      sakharuk  304:        if ( $#parstack > -1 ) {
1.55      albertel  305: 	 if ($Apache::lonxml::redirection) {
                    306: 	   $Apache::lonxml::outputstack['-1'] .= 
                    307: 	     &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);
                    308: 	 } else {
                    309: 	   $finaloutput .= &Apache::run::evaluate($result,$safeeval,
                    310: 						  $parstack[$#parstack]);
                    311: 	 }
1.16      albertel  312:        } else {
                    313: 	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
1.13      albertel  314:        }
1.16      albertel  315:        $result = '';
1.55      albertel  316:      } 
                    317:      if ($token->[0] eq 'E') { 
1.97    ! albertel  318:        &end_tag(\@stack,\@parstack,$token);
1.2       sakharuk  319:      }
1.5       albertel  320:    }
1.16      albertel  321:    pop @pars;
1.23      albertel  322:    pop @Apache::lonxml::pwd;
1.3       sakharuk  323:  }
1.24      sakharuk  324: 
1.59      albertel  325: # if ($target eq 'meta') {
                    326: #   $finaloutput.=&endredirection;
                    327: # }
1.67      www       328: 
                    329:   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
                    330:       $finaloutput=&afterburn($finaloutput);
                    331:   }
                    332: 
1.3       sakharuk  333:  return $finaloutput;
1.15      albertel  334: }
                    335: 
1.67      www       336: 
1.15      albertel  337: sub recurse {
                    338:   
                    339:   my @innerstack = (); 
                    340:   my @innerparstack = ();
                    341:   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
1.16      albertel  342:   my @pat = ();
1.23      albertel  343:   &newparser(\@pat,\$newarg);
1.15      albertel  344:   my $tokenpat;
                    345:   my $partstring = '';
                    346:   my $output='';
1.16      albertel  347:   my $decls='';
                    348:   while ( $#pat > -1 ) {
                    349:     while  ($tokenpat = $pat[$#pat]->get_token) {
1.57      albertel  350:       if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
1.61      albertel  351: 	if ($metamode<1) { $partstring=$tokenpat->[1]; }
1.57      albertel  352:       } elsif ($tokenpat->[0] eq 'PI') {
1.61      albertel  353: 	if ($metamode<1) { $partstring=$tokenpat->[2]; }
1.16      albertel  354:       } elsif ($tokenpat->[0] eq 'S') {
                    355: 	push (@innerstack,$tokenpat->[1]);
                    356: 	push (@innerparstack,&parstring($tokenpat));
1.19      albertel  357: 	&increasedepth($tokenpat);
1.84      albertel  358: 	$partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat,
                    359: 			       \@innerstack, \@innerparstack, \@pat,
                    360: 			       $safeeval, $style_for_target);
1.16      albertel  361:       } elsif ($tokenpat->[0] eq 'E') {
                    362: 	#clear out any tags that didn't end
                    363: 	while ($tokenpat->[1] ne $innerstack[$#innerstack] 
1.43      albertel  364: 	       && ($#innerstack > -1)) {
1.49      albertel  365: 	  &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
1.97    ! albertel  366: 	  &end_tag(\@innerstack,\@innerparstack,$tokenpat);
1.43      albertel  367: 	}
1.84      albertel  368: 	$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
                    369: 			       \@innerstack, \@innerparstack, \@pat,
                    370: 			       $safeeval, $style_for_target);
1.57      albertel  371:       } else {
                    372: 	&Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
1.16      albertel  373:       }
                    374:       #pass both the variable to the style tag, and the tag we 
                    375:       #are processing inside the <definedtag>
                    376:       if ( $partstring ne "" ) {
                    377: 	if ( $#parstack > -1 ) { 
                    378: 	  if ( $#innerparstack > -1 ) { 
                    379: 	    $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
                    380: 	  } else {
                    381: 	    $decls= $parstack[$#parstack];
                    382: 	  }
                    383: 	} else {
                    384: 	  if ( $#innerparstack > -1 ) { 
                    385: 	    $decls=$innerparstack[$#innerparstack];
                    386: 	  } else {
                    387: 	    $decls='';
                    388: 	  }
                    389: 	}
                    390: 	$output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
                    391: 	$partstring = '';
                    392:       }
1.17      albertel  393:       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
1.19      albertel  394: 				 &decreasedepth($tokenpat);}
1.15      albertel  395:     }
1.16      albertel  396:     pop @pat;
1.23      albertel  397:     pop @Apache::lonxml::pwd;
1.15      albertel  398:   }
                    399:   return $output;
1.7       albertel  400: }
                    401: 
                    402: sub callsub {
1.84      albertel  403:   my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.7       albertel  404:   my $currentstring='';
1.72      albertel  405:   my $nodefault;
1.7       albertel  406:   {
1.59      albertel  407:     my $sub1;
1.7       albertel  408:     no strict 'refs';
1.68      www       409:     my $tag=$token->[1];
                    410:     my $space=$Apache::lonxml::alltags{$tag};
                    411:     if (!$space) {
                    412: 	$tag=~tr/A-Z/a-z/;
                    413: 	$sub=~tr/A-Z/a-z/;
                    414: 	$space=$Apache::lonxml::alltags{$tag}
                    415:     }
1.97    ! albertel  416: 
        !           417:     my $deleted=0;
        !           418:     $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
        !           419:     if (($token->[0] eq 'S') && ($target eq 'modified')) {
        !           420:       $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
        !           421: 					     $parstack,$parser,$safeeval,
        !           422: 					     $style);
        !           423:     }
        !           424:     if (!$deleted) {
        !           425:       if ($space) {
        !           426: 	#&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
        !           427: 	$sub1="$space\:\:$sub";
        !           428: 	($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
        !           429: 					     $parstack,$parser,$safeeval,
        !           430: 					     $style);
        !           431:       } else {
        !           432: 	#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
        !           433: 	if ($metamode <1) {
        !           434: 	  if (defined($token->[4]) && ($metamode < 1)) {
        !           435: 	    $currentstring = $token->[4];
        !           436: 	  } else {
        !           437: 	    $currentstring = $token->[2];
        !           438: 	  }
1.62      sakharuk  439: 	}
1.7       albertel  440:       }
1.97    ! albertel  441:       #    &Apache::lonxml::debug("nodefalt:$nodefault:");
        !           442:       if ($currentstring eq '' && $nodefault eq '') {
        !           443: 	if ($target eq 'edit') {
        !           444: 	  &Apache::lonxml::debug("doing default edit for $token->[1]");
        !           445: 	  if ($token->[0] eq 'S') {
        !           446: 	    $currentstring = &Apache::edit::tag_start($target,$token);
        !           447: 	  } elsif ($token->[0] eq 'E') {
        !           448: 	    $currentstring = &Apache::edit::tag_end($target,$token);
        !           449: 	  }
        !           450: 	} elsif ($target eq 'modified') {
        !           451: 	  if ($token->[0] eq 'S') {
        !           452: 	    $currentstring = $token->[4];
        !           453: 	    $currentstring.=&Apache::edit::handle_insert();
        !           454: 	  } else {
        !           455: 	    $currentstring = $token->[2];
        !           456: 	  }
1.72      albertel  457: 	}
                    458:       }
1.7       albertel  459:     }
                    460:     use strict 'refs';
                    461:   }
                    462:   return $currentstring;
1.82      ng        463: }
                    464: 
1.96      albertel  465: sub setup_globals {
                    466:   my ($target)=@_;
                    467:   if ($target eq 'meta') {
                    468:     $Apache::lonxml::redirection = 0;
                    469:     $Apache::lonxml::metamode = 1;
                    470:     $Apache::lonxml::evaluate = 1;
                    471:     $Apache::lonxml::import = 0;
                    472:   } elsif ($target eq 'grade') {
                    473:     &startredirection;
                    474:     $Apache::lonxml::metamode = 0;
                    475:     $Apache::lonxml::evaluate = 1;
                    476:     $Apache::lonxml::import = 1;
                    477:   } elsif ($target eq 'modified') {
                    478:     $Apache::lonxml::redirection = 0;
                    479:     $Apache::lonxml::metamode = 0;
                    480:     $Apache::lonxml::evaluate = 0;
                    481:     $Apache::lonxml::import = 0;
                    482:   } elsif ($target eq 'edit') {
                    483:     $Apache::lonxml::redirection = 0;
                    484:     $Apache::lonxml::metamode = 0;
                    485:     $Apache::lonxml::evaluate = 0;
                    486:     $Apache::lonxml::import = 0;
                    487:   } else {
                    488:     $Apache::lonxml::redirection = 0;
                    489:     $Apache::lonxml::metamode = 0;
                    490:     $Apache::lonxml::evaluate = 1;
                    491:     $Apache::lonxml::import = 1;
                    492:   }
                    493: }
                    494: 
1.82      ng        495: sub init_safespace {
                    496:   my ($target,$safeeval,$safehole,$safeinit) = @_;
                    497:   $safeeval->permit("entereval");
                    498:   $safeeval->permit(":base_math");
                    499:   $safeeval->permit("sort");
                    500:   $safeeval->deny(":base_io");
                    501:   $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
                    502:   
                    503:   $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
                    504:   $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
                    505:   $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
                    506:   $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh');
                    507:   $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh');
                    508:   $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh');
                    509:   $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh');
                    510:   $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh');
                    511:   $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh');
                    512:   $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf');
                    513:   $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc');
                    514:   $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0');
                    515:   $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1');
                    516:   $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn');
                    517:   $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv');
                    518:   $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0');
                    519:   $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
                    520:   $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
                    521:   $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');
1.91      ng        522:   $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');
                    523:   $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');
                    524:   $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential');
                    525:   $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f');
                    526:   $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma');
                    527:   $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal');
                    528:   $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial');
                    529:   $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square');
                    530:   $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f');
                    531:   $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal');
                    532:   $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation');
1.93      ng        533:   $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index');
1.91      ng        534:   $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform');
                    535:   $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson');
                    536:   $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer');
                    537:   $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial');
                    538:   $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial');
                    539:   $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase');
                    540:   $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
                    541:   $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
                    542:   $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
                    543: 
1.82      ng        544: #need to inspect this class of ops
                    545: # $safeeval->deny(":base_orig");
1.91      ng        546:   $safeinit .= ';$external::target="'.$target.'";';
1.82      ng        547:   $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
                    548:   &Apache::run::run($safeinit,$safeeval);
1.17      albertel  549: }
                    550: 
1.55      albertel  551: sub startredirection {
                    552:   $Apache::lonxml::redirection++;
                    553:   push (@Apache::lonxml::outputstack, '');
                    554: }
                    555: 
                    556: sub endredirection {
                    557:   if (!$Apache::lonxml::redirection) {
1.72      albertel  558:     &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
1.55      albertel  559:     return '';
                    560:   }
                    561:   $Apache::lonxml::redirection--;
                    562:   pop @Apache::lonxml::outputstack;
1.97    ! albertel  563: }
        !           564: 
        !           565: sub end_tag {
        !           566:   my ($tagstack,$parstack,$token)=@_;
        !           567:   pop(@$tagstack);
        !           568:   pop(@$parstack);
        !           569:   &decreasedepth($token);
1.55      albertel  570: }
                    571: 
1.17      albertel  572: sub initdepth {
                    573:   @Apache::lonxml::depthcounter=();
                    574:   $Apache::lonxml::depth=-1;
                    575:   $Apache::lonxml::olddepth=-1;
                    576: }
                    577: 
                    578: sub increasedepth {
1.19      albertel  579:   my ($token) = @_;
1.17      albertel  580:   $Apache::lonxml::depth++;
                    581:   $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
                    582:   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
                    583:     $Apache::lonxml::olddepth=$Apache::lonxml::depth;
                    584:   }
1.42      albertel  585:   my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64      albertel  586:   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
1.54      albertel  587: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
1.17      albertel  588: }
                    589: 
                    590: sub decreasedepth {
1.19      albertel  591:   my ($token) = @_;
1.17      albertel  592:   $Apache::lonxml::depth--;
1.36      albertel  593:   if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
                    594:     $#Apache::lonxml::depthcounter--;
                    595:     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
                    596:   }
1.43      albertel  597:   if (  $Apache::lonxml::depth < -1) {
1.49      albertel  598:     &Apache::lonxml::warning("Unbalanced tags in resource");   
1.43      albertel  599:     $Apache::lonxml::depth='-1';
                    600:   }
1.42      albertel  601:   my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64      albertel  602:   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
1.54      albertel  603: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
1.1       sakharuk  604: }
1.19      albertel  605: 
                    606: sub get_all_text {
                    607: 
                    608:  my($tag,$pars)= @_;
                    609:  my $depth=0;
                    610:  my $token;
                    611:  my $result='';
1.57      albertel  612:  if ( $tag =~ m:^/: ) { 
                    613:    my $tag=substr($tag,1); 
                    614: #   &Apache::lonxml::debug("have:$tag:");
                    615:    while (($depth >=0) && ($token = $pars->get_token)) {
                    616: #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
                    617:      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
                    618:        $result.=$token->[1];
                    619:      } elsif ($token->[0] eq 'PI') {
                    620:        $result.=$token->[2];
                    621:      } elsif ($token->[0] eq 'S') {
                    622:        if ($token->[1] eq $tag) { $depth++; }
                    623:        $result.=$token->[4];
                    624:      } elsif ($token->[0] eq 'E')  {
                    625:        if ( $token->[1] eq $tag) { $depth--; }
                    626:        #skip sending back the last end tag
                    627:        if ($depth > -1) { $result.=$token->[2]; } else {
                    628: 	 $pars->unget_token($token);
                    629:        }
                    630:      }
                    631:    }
                    632:  } else {
                    633:    while ($token = $pars->get_token) {
                    634: #     &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
                    635:      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
                    636:        $result.=$token->[1];
                    637:      } elsif ($token->[0] eq 'PI') {
                    638:        $result.=$token->[2];
                    639:      } elsif ($token->[0] eq 'S') {
                    640:        if ( $token->[1] eq $tag) { 
                    641: 	 $pars->unget_token($token); last;
                    642:        } else {
                    643: 	 $result.=$token->[4];
                    644:        }
                    645:      } elsif ($token->[0] eq 'E')  {
                    646:        $result.=$token->[2];
1.36      albertel  647:      }
1.19      albertel  648:    }
                    649:  }
1.49      albertel  650: # &Apache::lonxml::debug("Exit:$result:");
1.19      albertel  651:  return $result
                    652: }
                    653: 
1.23      albertel  654: sub newparser {
                    655:   my ($parser,$contentref,$dir) = @_;
                    656:   push (@$parser,HTML::TokeParser->new($contentref));
1.56      albertel  657:   $$parser['-1']->xml_mode('1');
1.23      albertel  658:   if ( $dir eq '' ) {
                    659:     push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
                    660:   } else {
                    661:     push (@Apache::lonxml::pwd, $dir);
                    662:   } 
                    663: #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
                    664: #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
                    665: }
1.1       sakharuk  666: 
1.8       albertel  667: sub parstring {
                    668:   my ($token) = @_;
                    669:   my $temp='';
1.20      albertel  670:   map {
1.35      www       671:     unless ($_=~/\W/) {
1.42      albertel  672:       my $val=$token->[2]->{$_};
1.53      albertel  673:       $val =~ s/([\%\@\\])/\\$1/g;
1.51      albertel  674:       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
1.42      albertel  675:       $temp .= "my \$$_=\"$val\";"
1.20      albertel  676:     }
                    677:   } @{$token->[3]};
1.8       albertel  678:   return $temp;
                    679: }
1.22      albertel  680: 
1.34      www       681: sub writeallows {
                    682:     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
                    683:     my $thisdir=$thisurl;
                    684:     $thisdir=~s/\/[^\/]+$//;
                    685:     my %httpref=();
                    686:     map {
                    687:        $httpref{'httpref.'.
                    688:  	        &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;
                    689:     &Apache::lonnet::appenv(%httpref);
                    690: }
                    691: 
1.66      www       692: #
                    693: # Afterburner handles anchors, highlights and links
                    694: #
                    695: sub afterburn {
                    696:     my $result=shift;
                    697:     map {
                    698:        my ($name, $value) = split(/=/,$_);
                    699:        $value =~ tr/+/ /;
                    700:        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    701:        if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
                    702:            unless ($ENV{'form.'.$name}) {
                    703:               $ENV{'form.'.$name}=$value;
                    704: 	   }
                    705:        }
                    706:     } (split(/&/,$ENV{'QUERY_STRING'}));
                    707:     if ($ENV{'form.highlight'}) {
                    708:         map {
                    709:            my $anchorname=$_;
                    710: 	   my $matchthis=$anchorname;
                    711:            $matchthis=~s/\_+/\\s\+/g;
                    712:            $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
                    713:        } split(/\,/,$ENV{'form.highlight'});
                    714:     }
                    715:     if ($ENV{'form.link'}) {
                    716:         map {
                    717:            my ($anchorname,$linkurl)=split(/\>/,$_);
                    718: 	   my $matchthis=$anchorname;
                    719:            $matchthis=~s/\_+/\\s\+/g;
                    720:            $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
                    721:        } split(/\,/,$ENV{'form.link'});
                    722:     }
                    723:     if ($ENV{'form.anchor'}) {
                    724:         my $anchorname=$ENV{'form.anchor'};
                    725: 	my $matchthis=$anchorname;
                    726:         $matchthis=~s/\_+/\\s\+/g;
                    727:         $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
                    728:         $result.=(<<"ENDSCRIPT");
                    729: <script>
                    730:     document.location.hash='$anchorname';
                    731: </script>
                    732: ENDSCRIPT
                    733:     }
                    734:     return $result;
                    735: }
                    736: 
1.79      www       737: sub storefile {
                    738:     my ($file,$contents)=@_;
                    739:     if (my $fh=Apache::File->new('>'.$file)) {
                    740: 	print $fh $contents;
                    741:         $fh->close();
                    742:     }
                    743: }
                    744: 
1.78      www       745: sub inserteditinfo {
                    746:       my ($result,$filecontents)=@_;
                    747:       unless ($filecontents) {
                    748: 	  $filecontents=(<<SIMPLECONTENT);
                    749: <html>
                    750: <head>
                    751: <title>
                    752:                            Title of Document Goes Here
                    753: </title>
                    754: </head>
                    755: <body bgcolor="#FFFFFF">
                    756: 
                    757:                            Body of Document Goes Here
                    758: 
                    759: </body>
                    760: </html>
                    761: SIMPLECONTENT
                    762:       }
                    763:       my $editheader='<a href="#editsection">Edit below</a><hr />';
                    764:       my $editfooter=(<<ENDFOOTER);
                    765: <hr />
                    766: <a name="editsection" />
                    767: <form method="post">
                    768: <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
                    769: <br />
                    770: <input type="submit" name="savethisfile" value="Save this file" />
                    771: </form>
                    772: ENDFOOTER
                    773:       $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
                    774:       $result=~s/(\<\/body\>)/$editfooter/is;
                    775:       return $result;
                    776: }
                    777: 
1.24      sakharuk  778: sub handler {
                    779:   my $request=shift;
1.68      www       780: 
1.64      albertel  781:   my $target='web';
1.68      www       782: 
1.65      albertel  783:   $Apache::lonxml::debug=0;
1.68      www       784: 
1.25      sakharuk  785:   if ($ENV{'browser.mathml'}) {
1.27      albertel  786:     $request->content_type('text/xml');
                    787:   } else {
                    788:     $request->content_type('text/html');
1.25      sakharuk  789:   }
1.64      albertel  790:   
1.27      albertel  791:   $request->send_http_header;
1.64      albertel  792:   
1.45      www       793:   return OK if $request->header_only;
1.27      albertel  794: 
1.79      www       795: 
                    796:   my $file=&Apache::lonnet::filelocation("",$request->uri);
1.78      www       797: #
                    798: # Edit action? Save file.
                    799: #
                    800:   unless ($ENV{'request.state'} eq 'published') {
                    801:       if ($ENV{'form.savethisfile'}) {
1.79      www       802: 	  &storefile($file,$ENV{'form.filecont'});
1.78      www       803:       }
                    804:   }
1.24      sakharuk  805:   my %mystyle;
1.50      albertel  806:   my $result = ''; 
                    807:   my $filecontents=&Apache::lonnet::getfile($file);
                    808:   if ($filecontents == -1) {
1.78      www       809:     $result=(<<ENDNOTFOUND);
                    810: <html>
                    811: <head>
                    812: <title>File not found</title>
                    813: </head>
                    814: <body bgcolor="#FFFFFF">
                    815: <b>File not found: $file</b>
                    816: </body>
                    817: </html>
                    818: ENDNOTFOUND
1.50      albertel  819:     $filecontents='';
                    820:   } else {
                    821:     $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
1.78      www       822:   }
                    823: 
                    824: #
                    825: # Edit action? Insert editing commands
                    826: #
                    827:   unless ($ENV{'request.state'} eq 'published') {
                    828:       $result=&inserteditinfo($result,$filecontents);
1.66      www       829:   }
1.50      albertel  830: 
1.67      www       831:   $request->print($result);
1.64      albertel  832: 
1.34      www       833:   writeallows($request->uri);
1.45      www       834:   return OK;
1.24      sakharuk  835: }
                    836:  
1.22      albertel  837: sub debug {
                    838:   if ($Apache::lonxml::debug eq 1) {
1.96      albertel  839:     print("DEBUG:".$_[0]."<br />\n");
1.22      albertel  840:   }
                    841: }
1.49      albertel  842: 
1.22      albertel  843: sub error {
1.74      albertel  844:   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
1.55      albertel  845:     print "<b>ERROR:</b>".$_[0]."<br />\n";
1.52      albertel  846:   } else {
                    847:     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
                    848:     #notify author
                    849:     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
                    850:     #notify course
                    851:     if ( $ENV{'request.course.id'} ) {
                    852:       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
                    853:       foreach my $user (split /\,/, $users) {
                    854: 	($user,my $domain) = split /:/, $user;
1.54      albertel  855: 	&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
1.52      albertel  856:       }
                    857:     }
1.74      albertel  858: 
1.52      albertel  859:     #FIXME probably shouldn't have me get everything forever.
1.54      albertel  860:     &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
1.74      albertel  861:     #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
1.52      albertel  862:   }
1.22      albertel  863: }
1.49      albertel  864: 
1.22      albertel  865: sub warning {
1.73      harris41  866:   if ($ENV{'request.state'} eq 'construct') {
1.55      albertel  867:     print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
1.73      harris41  868:   }
1.83      albertel  869: }
                    870: 
                    871: sub get_param {
                    872:   my ($param,$parstack,$safeeval,$context) = @_;
                    873:   if ( ! $context ) { $context = -1; }
                    874:   my $args ='';
                    875:   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
                    876:   return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
1.22      albertel  877: }
                    878: 
1.74      albertel  879: sub register_insert {
1.75      albertel  880:   my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
1.74      albertel  881:   my $i;
1.76      albertel  882:   my $tagnum=0;
1.74      albertel  883:   my @order;
                    884:   for ($i=0;$i < $#data; $i++) {
                    885:     my $line = $data[$i];
                    886:     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
                    887:     if ( $line =~ /TABLE/ ) { last; }
1.92      albertel  888:     my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
1.76      albertel  889:     $insertlist{"$tagnum.tag"} = $tag;
                    890:     $insertlist{"$tagnum.description"} = $descrip;
1.92      albertel  891:     $insertlist{"$tagnum.color"} = $color;
1.76      albertel  892:     $insertlist{"$tagnum.function"} = $function;
                    893:     $insertlist{"$tagnum.show"}= $show;
1.92      albertel  894:     $insertlist{"$tag.num"}=$tagnum;
1.76      albertel  895:     $tagnum++;
1.74      albertel  896:   }
1.76      albertel  897:   $i++; #skipping TABLE line
                    898:   $tagnum = 0;
1.74      albertel  899:   for (;$i < $#data;$i++) {
                    900:     my $line = $data[$i];
1.76      albertel  901:     my ($mnemonic,@which) = split(/ +/,$line);
                    902:     my $tag = $insertlist{"$tagnum.tag"};
1.74      albertel  903:     for (my $j=0;$j <$#which;$j++) {
                    904:       if ( $which[$j] eq 'Y' ) {
1.76      albertel  905: 	if ($insertlist{"$j.show"} ne 'no') {
                    906: 	  push(@{ $insertlist{"$tag.which"} },$j);
                    907: 	}
1.74      albertel  908:       }
                    909:     }
1.76      albertel  910:     $tagnum++;
1.74      albertel  911:   }
                    912: }
1.1       sakharuk  913: 1;
                    914: __END__
1.68      www       915: 
                    916: 

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