[BACK]Return to lonxml.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.384 and 1.470

version 1.384, 2005/10/18 21:46:19 version 1.470, 2007/12/05 14:52:15
Line 40 Line 40
   
 package Apache::lonxml;   package Apache::lonxml; 
 use vars   use vars 
 qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount @htmlareafields);  qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
 use strict;  use strict;
   use LONCAPA;
 use HTML::LCParser();  use HTML::LCParser();
 use HTML::TreeBuilder();  use HTML::TreeBuilder();
 use HTML::Entities();  use HTML::Entities();
Line 52  use Math::Random(); Line 53  use Math::Random();
 use Opcode();  use Opcode();
 use POSIX qw(strftime);  use POSIX qw(strftime);
 use Time::HiRes qw( gettimeofday tv_interval );  use Time::HiRes qw( gettimeofday tv_interval );
   use Symbol();
   
 sub register {  sub register {
   my ($space,@taglist) = @_;    my ($space,@taglist) = @_;
Line 87  use Apache::loncommon(); Line 89  use Apache::loncommon();
 use Apache::lonfeedback();  use Apache::lonfeedback();
 use Apache::lonmsg();  use Apache::lonmsg();
 use Apache::loncacc();  use Apache::loncacc();
   use Apache::lonmaxima();
 use Apache::lonlocal;  use Apache::lonlocal;
   
 #==================================================   Main subroutine: xmlparse    #====================================   Main subroutine: xmlparse  
   
 #debugging control, to turn on debugging modify the correct handler  #debugging control, to turn on debugging modify the correct handler
   
 $Apache::lonxml::debug=0;  $Apache::lonxml::debug=0;
   
 # keeps count of the number of warnings and errors generated in a parse  # keeps count of the number of warnings and errors generated in a parse
Line 122  $evaluate = 1; Line 127  $evaluate = 1;
 # stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
 # has the dynamic menu been updated to know about this resource  # stores all Scrit Vars displays for later showing
 $Apache::lonxml::registered=0;  my @script_var_displays=();
   
 # a pointer the the Apache request object  # a pointer the the Apache request object
 $Apache::lonxml::request='';  $Apache::lonxml::request='';
Line 132  $Apache::lonxml::request=''; Line 137  $Apache::lonxml::request='';
 $Apache::lonxml::counter=1;  $Apache::lonxml::counter=1;
 $Apache::lonxml::counter_changed=0;  $Apache::lonxml::counter_changed=0;
   
   # Part counter hash.   In analysis mode, the
   # problems can use this to record which parts increment the counter
   # by how much.  The counter subs will maintain this hash via
   # their optional part parameters.  Note that the assumption is that
   # analysis is done in one request and therefore it is not necessary to
   # save this information request-to-request.
   
   
   %Apache::lonxml::counters_per_part = ();
   
 #internal check on whether to look at style defs  #internal check on whether to look at style defs
 $Apache::lonxml::usestyle=1;  $Apache::lonxml::usestyle=1;
   
Line 148  $Apache::lonxml::post_evaluate=1; Line 163  $Apache::lonxml::post_evaluate=1;
 #a header message to emit in the case of any generated warning or errors  #a header message to emit in the case of any generated warning or errors
 $Apache::lonxml::warnings_error_header='';  $Apache::lonxml::warnings_error_header='';
   
 sub xmlbegin {  #  Control whether or not LaTeX symbols should be substituted for their
     my ($style)=@_;  #  \ style equivalents...this may be turned off e.g. in an verbatim
     my $output='';  #  environment.
     @htmlareafields=();  
     if ($env{'browser.mathml'}) {  $Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
  $output='<?xml version="1.0"?>'  
             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"  sub enable_LaTeX_substitutions {
 #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '      $Apache::lonxml::substitute_LaTeX_symbols = 1;
               }
 #    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'  sub disable_LaTeX_substitutions {
     .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'      $Apache::lonxml::substitute_LaTeX_symbols = 0;
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '   
     .'xmlns="http://www.w3.org/1999/xhtml">';  
     } else {  
  $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';  
     }  
     if ($style eq 'encode') {  
  $output=&HTML::Entities::encode($output,'<>&"');  
     }  
     return $output;  
 }  }
   
 sub xmlend {  sub xmlend {
Line 190  sub xmlend { Line 196  sub xmlend {
  $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';   $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
  &Apache::lonxml::newparser($parser,\$discussion,'');   &Apache::lonxml::newparser($parser,\$discussion,'');
  return '';   return '';
     } else {  
  return $discussion.&Apache::loncommon::endbodytag();  
     }      }
   
       return $discussion;
 }  }
   
 sub tokeninputfield {  sub tokeninputfield {
Line 262  sub printtokenheader { Line 268  sub printtokenheader {
     my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;      my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
     unless ($token) { return ''; }      unless ($token) { return ''; }
   
     my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();      my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
     unless ($tsymb) {      unless ($tsymb) {
  $tsymb=$symb;   $tsymb=$symb;
     }      }
Line 272  sub printtokenheader { Line 278  sub printtokenheader {
         $tcrsid=$courseid;          $tcrsid=$courseid;
     }      }
   
     my %reply=&Apache::lonnet::get('environment',      my $plainname=&Apache::loncommon::plainname($tuname,$tudom);
               ['firstname','middlename','lastname','generation'],  
               $tudom,$tuname);  
     my $plainname=$reply{'firstname'}.' '.   
                   $reply{'middlename'}.' '.  
                   $reply{'lastname'}.' '.  
   $reply{'generation'};  
   
     if ($target eq 'web') {      if ($target eq 'web') {
         my %idhash=&Apache::lonnet::idrget($tudom,($tuname));          my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
Line 296  sub printtokenheader { Line 296  sub printtokenheader {
     }      }
 }  }
   
 sub fontsettings {  
     my $headerstring='';  
     if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {   
  $headerstring.=  
     '<meta Content-Type="text/html; charset=x-mac-roman" />';  
     } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {  
  $headerstring.=  
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';  
     }  
     return $headerstring;  
 }  
   
 sub printalltags {  sub printalltags {
   my $temp;    my $temp;
   foreach $temp (sort keys %Apache::lonxml::alltags) {    foreach $temp (sort keys %Apache::lonxml::alltags) {
Line 343  sub xmlparse { Line 331  sub xmlparse {
      }       }
  }   }
      }       }
  } elsif ($env{'construct.style'} && ($env{'request.state'} eq 'construct')) {   } elsif ($env{'construct.style'}
     && ($env{'request.state'} eq 'construct')) {
      my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});       my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});
      my $styletext=&Apache::lonnet::getfile($location);       my $styletext=&Apache::lonnet::getfile($location);
        if ($styletext ne '-1') {       if ($styletext ne '-1') {
           %style_for_target = (%style_for_target,   %style_for_target = (%style_for_target,
                           &Apache::style::styleparser($target,$styletext));        &Apache::style::styleparser($target,$styletext));
       }       }
  }   }
 #&printalltags();  #&printalltags();
  my @pars = ();   my @pars = ();
Line 369  sub xmlparse { Line 358  sub xmlparse {
  &initdepth();   &initdepth();
  &init_alarm();   &init_alarm();
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    $safeeval,\%style_for_target);     $safeeval,\%style_for_target,1);
   
    if (@stack) {
        &warning("At end of file some tags were still left unclosed, ".
         '<tt>&lt;'.join('&gt;</tt>, <tt>&lt;',reverse(@stack)).
         '&gt;</tt>');
    }
  if ($env{'request.uri'}) {   if ($env{'request.uri'}) {
     &writeallows($env{'request.uri'});      &writeallows($env{'request.uri'});
  }   }
  &do_registered_ssi();   &do_registered_ssi();
  if ($Apache::lonxml::counter_changed) { &store_counter() }   if ($Apache::lonxml::counter_changed) { &store_counter() }
   
    &clean_safespace($safeeval);
   
    if (@script_var_displays) {
        $finaloutput .= join('',@script_var_displays);
        undef(@script_var_displays);
    }
    &init_state();
  if ($env{'form.return_only_error_and_warning_counts'}) {   if ($env{'form.return_only_error_and_warning_counts'}) {
      return "$errorcount:$warningcount";       return "$errorcount:$warningcount";
  }   }
Line 384  sub xmlparse { Line 386  sub xmlparse {
   
 sub latex_special_symbols {  sub latex_special_symbols {
     my ($string,$where)=@_;      my ($string,$where)=@_;
       #
       #  If e.g. in verbatim mode, then don't substitute.
       #  but return original string.
       #
       if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
    return $string;
       }
     if ($where eq 'header') {      if ($where eq 'header') {
  $string =~ s/(\\|_|\^)/ /g;   $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
  $string =~ s/(\$|%|\{|\})/\\$1/g;   $string =~ s/(\$|%|\{|\})/\\$1/g;
  $string =~ s/_/ /g;  
  $string=&Apache::lonprintout::character_chart($string);   $string=&Apache::lonprintout::character_chart($string);
  # any & or # leftover should be safe to just escape   # any & or # leftover should be safe to just escape
         $string=~s/([^\\])\&/$1\\\&/g;          $string=~s/([^\\])\&/$1\\\&/g;
         $string=~s/([^\\])\#/$1\\\#/g;          $string=~s/([^\\])\#/$1\\\#/g;
    $string =~ s/_/\\_/g;              # _ -> \_
    $string =~ s/\^/\\\^{}/g;          # ^ -> \^{} 
     } else {      } else {
  $string=~s/\\/\\ensuremath{\\backslash}/g;   $string=~s/\\/\\ensuremath{\\backslash}/g;
  $string=~s/\\\%|\%/\\\%/g;   $string=~s/\\\%|\%/\\\%/g;
Line 413  sub latex_special_symbols { Line 423  sub latex_special_symbols {
 }  }
   
 sub inner_xmlparse {  sub inner_xmlparse {
   my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
   my $finaloutput = '';    my $finaloutput = '';
   my $result;    my $result;
   my $token;    my $token;
   my $dontpop=0;    my $dontpop=0;
     my $startredirection = $Apache::lonxml::redirection;
   while ( $#$pars > -1 ) {    while ( $#$pars > -1 ) {
     while ($token = $$pars['-1']->get_token) {      while ($token = $$pars['-1']->get_token) {
       if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {        if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
Line 527  sub inner_xmlparse { Line 538  sub inner_xmlparse {
   #   $finaloutput.=&endredirection;    #   $finaloutput.=&endredirection;
   # }    # }
   
     if ( $start && $target eq 'grade') { &endredirection(); }
     if ( $Apache::lonxml::redirection > $startredirection) {
         while ($Apache::lonxml::redirection > $startredirection) {
     $finaloutput .= &endredirection();
         }
     }
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
   }        }    
Line 556  sub callsub { Line 572  sub callsub {
     }      }
   
     my $deleted=0;      my $deleted=0;
     $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);  
     if (($token->[0] eq 'S') && ($target eq 'modified')) {      if (($token->[0] eq 'S') && ($target eq 'modified')) {
       $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,        $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
      $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
Line 592  sub callsub { Line 607  sub callsub {
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
     $currentstring = &Apache::edit::tag_end($target,$token);      $currentstring = &Apache::edit::tag_end($target,$token);
   }    }
  } elsif ($target eq 'modified') {   }
         }
         if ($target eq 'modified' && $nodefault eq '') {
     if ($currentstring eq '') {
         if ($token->[0] eq 'S') {
     $currentstring = $token->[4];
         } elsif ($token->[0] eq 'E') {
     $currentstring = $token->[2];
         } else {
     $currentstring = $token->[2];
         }
     }
   if ($token->[0] eq 'S') {    if ($token->[0] eq 'S') {
     $currentstring = $token->[4];        $currentstring.=&Apache::edit::handle_insert();
     $currentstring.=&Apache::edit::handle_insert();  
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
     $currentstring = $token->[2];        $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
             $currentstring.=&Apache::edit::handle_insertafter($token->[1]);  
   } else {  
     $currentstring = $token->[2];  
   }    }
  }  
       }        }
     }      }
     use strict 'refs';      use strict 'refs';
Line 610  sub callsub { Line 631  sub callsub {
   return $currentstring;    return $currentstring;
 }  }
   
   {
       my %state;
   
       sub init_state {
    undef(%state);
       }
       
       sub set_state {
    my ($key,$value) = @_;
    $state{$key} = $value;
    return $value;
       }
       sub get_state {
    my ($key) = @_;
    return $state{$key};
       }
   }
   
 sub setup_globals {  sub setup_globals {
   my ($request,$target)=@_;    my ($request,$target)=@_;
   $Apache::lonxml::request=$request;    $Apache::lonxml::request=$request;
   $Apache::lonxml::registered = 0;  
   @Apache::lonxml::htmlareafields=();  
   $errorcount=0;    $errorcount=0;
   $warningcount=0;    $warningcount=0;
   $Apache::lonxml::default_homework_loaded=0;    $Apache::lonxml::default_homework_loaded=0;
   $Apache::lonxml::usestyle=1;    $Apache::lonxml::usestyle=1;
   &init_counter();    &init_counter();
     &clear_bubble_lines_for_part();
     &init_state();
     &set_state('target',$target);
   @Apache::lonxml::pwd=();    @Apache::lonxml::pwd=();
   @Apache::lonxml::extlinks=();    @Apache::lonxml::extlinks=();
     @script_var_displays=();
   @Apache::lonxml::ssi_info=();    @Apache::lonxml::ssi_info=();
   $Apache::lonxml::post_evaluate=1;    $Apache::lonxml::post_evaluate=1;
   $Apache::lonxml::warnings_error_header='';    $Apache::lonxml::warnings_error_header='';
     $Apache::lonxml::substitute_LaTeX_symbols = 1;
   if ($target eq 'meta') {    if ($target eq 'meta') {
     $Apache::lonxml::redirection = 0;      $Apache::lonxml::redirection = 0;
     $Apache::lonxml::metamode = 1;      $Apache::lonxml::metamode = 1;
Line 636  sub setup_globals { Line 678  sub setup_globals {
     $Apache::lonxml::evaluate = 1;      $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 1;      $Apache::lonxml::import = 1;
   } elsif ($target eq 'grade') {    } elsif ($target eq 'grade') {
     &startredirection;      &startredirection(); #ended in inner_xmlparse on exit
     $Apache::lonxml::metamode = 0;      $Apache::lonxml::metamode = 0;
     $Apache::lonxml::evaluate = 1;      $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 1;      $Apache::lonxml::import = 1;
Line 682  sub init_safespace { Line 724  sub init_safespace {
   '&chem_standard_order');    '&chem_standard_order');
   $safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status');    $safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status');
   
     $safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval');
     $safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check');
     $safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval,
     '&maxima_cas_formula_fix');
   
     $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval,
     '&capa_formula_fix');
   
   $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');    $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
   $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');    $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
   $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');    $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
Line 783  sub init_safespace { Line 833  sub init_safespace {
   $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');    $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
   $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');    $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
   $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');    $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
     $safehole->wrap(\&Apache::loncommon::languages,$safeeval,'&languages');
   $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');    $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
   $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');    $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
     $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
     $safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');
   $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');    $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');
   #  use Data::Dumper;
   #  $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper');
 #need to inspect this class of ops  #need to inspect this class of ops
 # $safeeval->deny(":base_orig");  # $safeeval->deny(":base_orig");
   $safeeval->permit("require");    $safeeval->permit("require");
Line 795  sub init_safespace { Line 849  sub init_safespace {
   &initialize_rndseed($safeeval);    &initialize_rndseed($safeeval);
 }  }
   
   sub clean_safespace {
       my ($safeeval) = @_;
       delete_package_recurse($safeeval->{Root});
   }
   
   sub delete_package_recurse {
        my ($package) = @_;
        my @subp;
        {
    no strict 'refs';
    while (my ($key,$val) = each(%{*{"$package\::"}})) {
        if (!defined($val)) { next; }
        local (*ENTRY) = $val;
        if (defined *ENTRY{HASH} && $key =~ /::$/ &&
    $key ne "main::" && $key ne "<none>::")
        {
    my ($p) = $package ne "main" ? "$package\::" : "";
    ($p .= $key) =~ s/::$//;
    push(@subp,$p);
        }
    }
        }
        foreach my $p (@subp) {
    delete_package_recurse($p);
        }
        Symbol::delete_package($package);
   }
   
 sub initialize_rndseed {  sub initialize_rndseed {
     my ($safeeval)=@_;      my ($safeeval)=@_;
     my $rndseed;      my $rndseed;
     my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();      my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
     $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);      $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
     my $safeinit = '$external::randomseed="'.$rndseed.'";';      my $safeinit = '$external::randomseed="'.$rndseed.'";';
     &Apache::lonxml::debug("Setting rndseed to $rndseed");      &Apache::lonxml::debug("Setting rndseed to $rndseed");
Line 860  sub endredirection { Line 942  sub endredirection {
     }      }
     pop @Apache::lonxml::outputstack;      pop @Apache::lonxml::outputstack;
 }  }
   sub in_redirection {
       return ($Apache::lonxml::redirection > 0)
   }
   
 sub end_tag {  sub end_tag {
   my ($tagstack,$parstack,$token)=@_;    my ($tagstack,$parstack,$token)=@_;
Line 870  sub end_tag { Line 955  sub end_tag {
   
 sub initdepth {  sub initdepth {
   @Apache::lonxml::depthcounter=();    @Apache::lonxml::depthcounter=();
   $Apache::lonxml::depth=-1;    undef($Apache::lonxml::last_depth_count);
   $Apache::lonxml::olddepth=-1;  
 }  }
   
   
 my @timers;  my @timers;
 my $lasttime;  my $lasttime;
   # @Apache::lonxml::depthcounter -> count of tags that exist so
   #                                  far at each level
   # $Apache::lonxml::last_depth_count -> when ascending, need to
   # remember the count for the level below the current level (for
   # example going from 1_2 -> 1 -> 1_3 need to remember the 2 )
   
 sub increasedepth {  sub increasedepth {
   my ($token) = @_;    my ($token) = @_;
   $Apache::lonxml::depth++;    push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1);
   $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;    undef($Apache::lonxml::last_depth_count);
   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {  
     $Apache::lonxml::olddepth=$Apache::lonxml::depth;  
   }  
   my $time;    my $time;
   if ($Apache::lonxml::debug eq "1") {    if ($Apache::lonxml::debug eq "1") {
       push(@timers,[&gettimeofday()]);        push(@timers,[&gettimeofday()]);
       $time=&tv_interval($lasttime);        $time=&tv_interval($lasttime);
       $lasttime=[&gettimeofday()];        $lasttime=[&gettimeofday()];
   }    }
   my $spacing='  'x($Apache::lonxml::depth-1);    my $spacing='  'x($#Apache::lonxml::depthcounter);
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n");  #  &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time");
 #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";  #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
 }  }
   
 sub decreasedepth {  sub decreasedepth {
   my ($token) = @_;    my ($token) = @_;
   $Apache::lonxml::depth--;    if (  $#Apache::lonxml::depthcounter == -1) {
   if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {        &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
     $#Apache::lonxml::depthcounter--;  
     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;  
   }  
   if (  $Apache::lonxml::depth < -1) {  
     &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));  
     $Apache::lonxml::depth='-1';  
   }    }
     $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter);
   
   my ($timer,$time);    my ($timer,$time);
   if ($Apache::lonxml::debug eq "1") {    if ($Apache::lonxml::debug eq "1") {
       $timer=pop(@timers);        $timer=pop(@timers);
       $time=&tv_interval($lasttime);        $time=&tv_interval($lasttime);
       $lasttime=[&gettimeofday()];        $lasttime=[&gettimeofday()];
   }    }
   my $spacing='  'x$Apache::lonxml::depth;    my $spacing='  'x($#Apache::lonxml::depthcounter);
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n");  #  &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer));
 #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";  #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
 }  }
   
   sub get_id {
       my ($parstack,$safeeval)=@_;
       my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
       if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\d\s[:punct:]])/) {
    &error(&mt("ID &quot;[_1]&quot; contains invalid characters, IDs are only allowed to contain letters, numbers, spaces and -",'<tt>'.$id.'</tt>'));
       }
       if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
       return $id;
   }
   
 sub get_all_text_unbalanced {  sub get_all_text_unbalanced {
 #there is a copy of this in lonpublisher.pm  #there is a copy of this in lonpublisher.pm
     my($tag,$pars)= @_;      my($tag,$pars)= @_;
Line 926  sub get_all_text_unbalanced { Line 1020  sub get_all_text_unbalanced {
     $tag='<'.$tag.'>';      $tag='<'.$tag.'>';
     while ($token = $$pars[-1]->get_token) {      while ($token = $$pars[-1]->get_token) {
  if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {   if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
     if ($token->[2]) {      if ($token->[0] eq 'T' && $token->[2]) {
  $result.='<![CDATA['.$token->[1].']]>';   $result.='<![CDATA['.$token->[1].']]>';
     } else {      } else {
  $result.=$token->[1];   $result.=$token->[1];
Line 948  sub get_all_text_unbalanced { Line 1042  sub get_all_text_unbalanced {
  }   }
     }      }
     return $result      return $result
   
 }  }
   
   #########################################################################
   #                                                                       #
   #           bubble line counter management                              #
   #                                                                       #
   #########################################################################
   
   =pod
   
   For bubble grading mode and exam bubble printing mode, the tracking of
   the current 'bubble line number' is stored in the %env element
   'form.counter', and is modifed and handled by the following routines.
   
   The value of it is stored in $Apache:lonxml::counter when live and
   stored back to env after done.
   
   =item &increment_counter($increment);
   
   Increments the internal counter environment variable a specified amount
   
   Optional Arguments:
     $increment - amount to increment by (defaults to 1)
                  Also 1 if the value is negative or zero.
     $part_response - A concatenation of the part and response id
                      identifying exactly what is being 'answered'.
   
   
   =cut
   
 sub increment_counter {  sub increment_counter {
     my ($increment) = @_;      my ($increment, $part_response) = @_;
     if (defined($increment) && $increment gt 0) {      if (!defined($increment) || $increment le 0) {
  $Apache::lonxml::counter+=$increment;   $increment = 1;
     } else {      }
  $Apache::lonxml::counter++;      $Apache::lonxml::counter += $increment;
   
       # If the caller supplied the response_id parameter, 
       # Maintain its counter.. creating if necessary.
   
       if (defined($part_response)) {
    if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
       $Apache::lonxml::counters_per_part{$part_response} = 0;
    }
    $Apache::lonxml::counters_per_part{$part_response} += $increment;
    my $new_value = $Apache::lonxml::counters_per_part{$part_response};
     }      }
   
     $Apache::lonxml::counter_changed=1;      $Apache::lonxml::counter_changed=1;
 }  }
   
   =pod
   
   =item &init_counter($increment);
   
   Initialize the internal counter environment variable
   
   =cut
   
 sub init_counter {  sub init_counter {
     if (defined($env{'form.counter'})) {      if ($env{'request.state'} eq 'construct') {
    $Apache::lonxml::counter=1;
    $Apache::lonxml::counter_changed=1;
       } elsif (defined($env{'form.counter'})) {
  $Apache::lonxml::counter=$env{'form.counter'};   $Apache::lonxml::counter=$env{'form.counter'};
  $Apache::lonxml::counter_changed=0;   $Apache::lonxml::counter_changed=0;
     } else {      } else {
Line 972  sub init_counter { Line 1117  sub init_counter {
   
 sub store_counter {  sub store_counter {
     &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));      &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
       $Apache::lonxml::counter_changed=0;
     return '';      return '';
 }  }
   
   {
       my $state;
       sub clear_problem_counter {
    undef($state);
    &Apache::lonnet::delenv('form.counter');
    &Apache::lonxml::init_counter();
    &Apache::lonxml::store_counter();
       }
   
       sub remember_problem_counter {
    &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
    $state = $env{'form.counter'};
       }
   
       sub restore_problem_counter {
    if (defined($state)) {
       &Apache::lonnet::appenv(('form.counter' => $state));
    }
       }
       sub get_problem_counter {
    if ($Apache::lonxml::counter_changed) { &store_counter() }
    &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
    return $env{'form.counter'};
       }
   }
   
   =pod
   
   =item  bubble_lines_for_part(part_response)
   
   Returns the number of lines required to get a response for
   $part_response (this is just $Apache::lonxml::counters_per_part{$part_response}
   
   =cut
   
   sub bubble_lines_for_part {
       my ($part_response) = @_;
   
       if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
    return 0;
       } else {
    return $Apache::lonxml::counters_per_part{$part_response};
       }
   }
   
   =pod
   
   =item clear_bubble_lines_for_part
   
   Clears the hash of bubble lines per part.  If a caller
   needs to analyze several resources this should be called between
   resources to reset the hash for each problem being analyzed.
   
   =cut
   
   sub clear_bubble_lines_for_part {
       undef(%Apache::lonxml::counters_per_part);
   }
   
   =pod
   
   =item set_bubble_lines(part_response, value)
   
   If there is a problem part, that for whatever reason
   requires bubble lines that are not
   the same as the counter increment, it can call this sub during
   analysis to set its hash value explicitly.
   
   =cut
   
   sub set_bubble_lines {
       my ($part_response, $value) = @_;
   
       $Apache::lonxml::counters_per_part{$part_response} = $value;
   }
   
   =pod
   
   =item get_bubble_line_hash
   
   Returns the current bubble line hash.  This is assumed to 
   be small so we return a copy
   
   
   =cut
   
   sub get_bubble_line_hash {
       return %Apache::lonxml::counters_per_part;
   }
   
   
   #--------------------------------------------------
   
 sub get_all_text {  sub get_all_text {
     my($tag,$pars,$style)= @_;      my($tag,$pars,$style)= @_;
     my $gotfullstack=1;      my $gotfullstack=1;
Line 1094  sub newparser { Line 1333  sub newparser {
 }  }
   
 sub parstring {  sub parstring {
   my ($token) = @_;      my ($token) = @_;
   my $temp='';      my (@vars,@values);
   foreach (@{$token->[3]}) {      foreach my $attr (@{$token->[3]}) {
     unless ($_=~/\W/) {   if ($attr!~/\W/) {
       my $val=$token->[2]->{$_};      my $val=$token->[2]->{$attr};
       $val =~ s/([\%\@\\\"\'])/\\$1/g;      $val =~ s/([\%\@\\\"\'])/\\$1/g;
       $val =~ s/(\$[^{a-zA-Z_])/\\$1/g;      $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g;
       $val =~ s/(\$)$/\\$1/;      $val =~ s/(\$)$/\\$1/;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }      #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       $temp .= "my \$$_=\"$val\";";      push(@vars,"\$$attr");
     }      push(@values,"\"$val\"");
   }   }
   return $temp;      }
       my $var_init = 
    (@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');'
           : '';
       return $var_init;
 }  }
   
 sub extlink {  sub extlink {
Line 1128  sub writeallows { Line 1371  sub writeallows {
     my %httpref=();      my %httpref=();
     foreach (@extlinks) {      foreach (@extlinks) {
        $httpref{'httpref.'.         $httpref{'httpref.'.
          &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;           &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
     }      }
     @extlinks=();      @extlinks=();
     &Apache::lonnet::appenv(%httpref);      &Apache::lonnet::appenv(%httpref);
Line 1147  sub do_registered_ssi { Line 1390  sub do_registered_ssi {
  &Apache::lonnet::ssi($url,%form);   &Apache::lonnet::ssi($url,%form);
     }      }
 }  }
   
   sub add_script_result {
       my ($display) = @_;
       push(@script_var_displays, $display);
   }
   
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
Line 1227  SIMPLECONTENT Line 1476  SIMPLECONTENT
   
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents,$filetype)=@_;        my ($filecontents, $filetype, $filename)=@_;
       $filecontents = &HTML::Entities::encode($filecontents,'<>&"');        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';  #      my $editheader='<a href="#editsection">Edit below</a><hr />';
       my $xml_help = '';        my $xml_help = '';
       my $initialize='';        my $initialize='';
       if ($filetype eq 'html') {        my $textarea_id = 'filecont';
   my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();        my ($add_to_onload, $add_to_onresize);
   $initialize=&Apache::lonhtmlcommon::htmlareaheaders().        $initialize=&Apache::lonhtmlcommon::spellheader();
       &Apache::lonhtmlcommon::spellheader();        if ($filetype eq 'html' 
   if (!&Apache::lonhtmlcommon::htmlareablocked() &&    && (!&Apache::lonhtmlcommon::htmlareablocked() &&
       &Apache::lonhtmlcommon::htmlareabrowser()) {        &Apache::lonhtmlcommon::htmlareabrowser())) {
       $initialize.=(<<FULLPAGE);    $textarea_id .= '___Frame';
     my $lang = &Apache::lonhtmlcommon::htmlarea_lang();
     $initialize.=(<<FULLPAGE);
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  lonca
   
     HTMLArea.loadPlugin("FullPage");  
   
     function initDocument() {      function initDocument() {
  var editor=new HTMLArea("filecont",config);          var oFCKeditor = new FCKeditor('filecont');
  editor.registerPlugin(FullPage);   oFCKeditor.Config['CustomConfigurationsPath'] = '/fckeditor/loncapaconfig.js'  ;
  editor.generate();   oFCKeditor.Config['FullPage'] = true
    oFCKeditor.Config['AutoDetectLanguage'] = false;
           oFCKeditor.Config['DefaultLanguage'] = "$lang";
    oFCKeditor.ReplaceTextarea();
       }
       function check_if_dirty(editor) {
    if (editor.IsDirty()) {
       unClean();
    }
       }
       function FCKeditor_OnComplete(editor) {
    editor.Events.AttachEvent("OnSelectionChange",check_if_dirty);
    resize_textarea('$textarea_id','LC_aftertextarea');
     }      }
 </script>  </script>
 FULLPAGE  FULLPAGE
           } else {        } else {
       $initialize.=(<<FULLPAGE);    $initialize.=(<<FULLPAGE);
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  
     function initDocument() {      function initDocument() {
    resize_textarea('$textarea_id','LC_aftertextarea');
     }      }
 </script>  </script>
 FULLPAGE  FULLPAGE
   }        }
           $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;  
         $add_to_onload = 'initDocument();';
         $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";
   
         if ($filetype eq 'html') {
   $xml_help=&Apache::loncommon::helpLatexCheatsheet();    $xml_help=&Apache::loncommon::helpLatexCheatsheet();
       }        }
       my $cleanbut = '';  
   
       my $titledisplay=&display_title();        my $titledisplay=&display_title();
       my %lt=&Apache::lonlocal::texthash('st' => 'Save this',        my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit',
  'vi' => 'View',   'vi' => 'Save and View',
    'dv' => 'Discard Edits and View',
    'un' => 'undo',
  'ed' => 'Edit');   'ed' => 'Edit');
       my $buttons=(<<BUTTONS);        my $spelllink .=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
 $cleanbut        my $textarea_events = &Apache::edit::element_change_detection();
 <input type="submit" name="savethisfile" accesskey="s"  value="$lt{'st'}" />        my $form_events     = &Apache::edit::form_change_detection();
 <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />  
 BUTTONS  
       $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');  
       $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');  
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
 $initialize  $initialize
 <hr />  
 <a name="editsection" />  <a name="editsection" />
 <form method="post" name="xmledit">  <form $form_events method="post" name="xmledit">
 $xml_help    <div class="LC_edit_problem_editxml_header">
 <input type="hidden" name="editmode" value="$lt{'ed'}" />      <table class="LC_edit_problem_header_title"><tr><td>
 $buttons<br />          $filename
 <textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>        </td><td align="right">
 <br />$buttons          $xml_help
 <br />        </td></tr>
       </table>
       <div class="LC_edit_problem_discards">
         <input type="submit" name="discardview" accesskey="d" value="$lt{'dv'}" />
         <input type="submit" name="Undo" accesskey="u" value="$lt{'un'}" />
         $spelllink
       </div>
       <div class="LC_edit_problem_saves">
         <input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />
         <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
       </div>
     </div>
     <textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
     <div id="LC_aftertextarea">
       <br />
       $titledisplay
     </div>
 </form>  </form>
 $titledisplay  
 </body>  </body>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;        return ($editfooter,$add_to_onload,$add_to_onresize);;
       $result=~s/(\<\/body\>)/$editfooter/is;  
       return $result;  
 }  }
   
 sub get_target {  sub get_target {
Line 1351  sub handler { Line 1624  sub handler {
 #  #
 # Edit action? Save file.  # Edit action? Save file.
 #  #
     unless ($env{'request.state'} eq 'published') {      if (!($env{'request.state'} eq 'published')) {
  if ($env{'form.savethisfile'}) {   if ($env{'form.savethisfile'} || $env{'form.viewmode'} || $env{'form.Undo'}) {
     if (&storefile($file,$env{'form.filecont'})) {      my $html_file=&Apache::lonnet::getfile($file);
  &Apache::lonxml::info("<font COLOR=\"#0000FF\">".      my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'});
       &mt('Updated').": ".  
       &Apache::lonlocal::locallocaltime(time).  
       " </font>");  
     }   
  }   }
     }      }
     my %mystyle;      my %mystyle;
     my $result = '';      my $result = '';
     my $filecontents=&Apache::lonnet::getfile($file);      my $filecontents=&Apache::lonnet::getfile($file);
     if ($filecontents eq -1) {      if ($filecontents eq -1) {
  my $bodytag=&Apache::loncommon::bodytag('File Error');   my $start_page=&Apache::loncommon::start_page('File Error');
    my $end_page=&Apache::loncommon::end_page();
  my $fnf=&mt('File not found');   my $fnf=&mt('File not found');
  $result=(<<ENDNOTFOUND);   $result=(<<ENDNOTFOUND);
 <html>  $start_page
 <head>  
 <title>$fnf</title>  
 </head>  
 $bodytag  
 <b>$fnf: $file</b>  <b>$fnf: $file</b>
 </body>  $end_page
 </html>  
 ENDNOTFOUND  ENDNOTFOUND
         $filecontents='';          $filecontents='';
  if ($env{'request.state'} ne 'published') {   if ($env{'request.state'} ne 'published') {
Line 1393  ENDNOTFOUND Line 1658  ENDNOTFOUND
     }      }
 #  #
 # we are in construction space, see if edit mode forced  # we are in construction space, see if edit mode forced
             &Apache::loncommon::get_unprocessed_cgi              &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                           ($ENV{'QUERY_STRING'},['editmode']);      ['editmode']);
  }   }
  if (!$env{'form.editmode'} || $env{'form.viewmode'}) {   if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) {
       &Apache::structuretags::reset_problem_globals();
     $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,      $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
  '',%mystyle);   '',%mystyle);
     undef($Apache::lonhomework::parsing_a_task);      # .html files may contain <problem> or <Task> need to clean
       # up if it did
       &Apache::structuretags::reset_problem_globals();
       &Apache::lonhomework::finished_parsing();
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
       ['rawmode']);
       if ($env{'form.rawmode'}) { $result = $filecontents; }
       if ($filetype eq 'sty') {
    my $controls =
       ($env{'request.state'} eq 'construct') ? &Apache::londefdef::edit_controls()
                                              : '';
    my %options = ('bgcolor' => '#FFFFFF');
    $result = 
       &Apache::loncommon::start_page(undef,undef,\%options).
       $controls.
       $result.
       &Apache::loncommon::end_page();
       }
  }   }
     }      }
       
 #  #
 # Edit action? Insert editing commands  # Edit action? Insert editing commands
 #  #
     unless ($env{'request.state'} eq 'published') {      unless ($env{'request.state'} eq 'published') {
  if ($env{'form.editmode'} && (!($env{'form.viewmode'}))) {   if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
    {
     my $displayfile=$request->uri;      my $displayfile=$request->uri;
     $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
     my $bodytag='<body bgcolor="#FFFFFF">';  
     if ($env{'environment.remote'} eq 'off') {      my ($edit_info, $add_to_onload, $add_to_onresize)=
  $bodytag=&Apache::loncommon::bodytag();   &inserteditinfo($filecontents,$filetype,$displayfile);
   
       my %options = 
    ('add_entries' =>
                      {'onresize' => $add_to_onresize,
       'onload'   => $add_to_onload,   });
   
       if ($env{'environment.remote'} ne 'off') {
    $options{'bgcolor'}   = '#FFFFFF';
    $options{'only_body'} = 1;
     }      }
     $result='<html>'.$bodytag.      my $js =
  &Apache::lonxml::message_location().'<h3>'.   &Apache::edit::js_change_detection().
  $displayfile.   &Apache::loncommon::resize_textarea_js();
  '</h3></body></html>';      my $start_page = &Apache::loncommon::start_page(undef,$js,
     $result=&inserteditinfo($result,$filecontents,$filetype);      \%options);
       $result=$start_page.
    &Apache::lonxml::message_location().
    $edit_info.
    &Apache::loncommon::end_page();
  }   }
     }      }
     if ($filetype eq 'html') { writeallows($request->uri); }      if ($filetype eq 'html') { &writeallows($request->uri); }
   
           
     &Apache::lonxml::add_messages(\$result);      &Apache::lonxml::add_messages(\$result);
     $request->print($result);      $request->print($result);
Line 1447  sub debug { Line 1743  sub debug {
     if ($Apache::lonxml::debug eq "1") {      if ($Apache::lonxml::debug eq "1") {
  $|=1;   $|=1;
  my $request=$Apache::lonxml::request;   my $request=$Apache::lonxml::request;
  if (!$request) { $request=Apache->request; }   if (!$request) {
       eval { $request=Apache->request; };
    }
    if (!$request) {
       eval { $request=Apache2::RequestUtil->request; };
    }
  $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");   $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
  #&Apache::lonnet::logthis($_[0]);   #&Apache::lonnet::logthis($_[0]);
     }      }
Line 1466  sub show_error_warn_msg { Line 1767  sub show_error_warn_msg {
 }  }
   
 sub error {  sub error {
       my @errors = @_;
   
     $errorcount++;      $errorcount++;
   
       if (defined($Apache::inputtags::part)) {
    if ( @Apache::inputtags::response ) {
       push(@errors,
    &mt("This error occurred while processing response [_1] in part [_2]",
        $Apache::inputtags::response[-1],
        $Apache::inputtags::part));
    } else {
       push(@errors,
    &mt("This error occurred while processing part [_1]",
        $Apache::inputtags::part));
    }
       }
   
     if ( &show_error_warn_msg() ) {      if ( &show_error_warn_msg() ) {
  # If printing in construction space, put the error inside <pre></pre>   # If printing in construction space, put the error inside <pre></pre>
  push(@Apache::lonxml::error_messages,   push(@Apache::lonxml::error_messages,
      $Apache::lonxml::warnings_error_header.       $Apache::lonxml::warnings_error_header.
      "<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");       "<b>ERROR:</b>".join("<br />\n",@errors)."<br />\n");
  $Apache::lonxml::warnings_error_header='';   $Apache::lonxml::warnings_error_header='';
     } else {      } else {
  my $errormsg;   my $errormsg;
Line 1479  sub error { Line 1796  sub error {
  if ( !$symb ) {   if ( !$symb ) {
     #public or browsers      #public or browsers
     $errormsg=&mt("An error occured while processing this resource. The author has been notified.");      $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
  }    }
    my $host=$Apache::lonnet::perlvar{'lonHostID'};
    push(@errors, "The error occurred on host <tt>$host</tt>");
   
    my $msg = join('<br />', @errors);
   
  #notify author   #notify author
  &Apache::lonmsg::author_res_msg($env{'request.filename'},join('<br />',@_));   &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
  #notify course   #notify course
  if ( $symb && $env{'request.course.id'} ) {   if ( $symb && $env{'request.course.id'} ) {
     my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);      my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1);
     my $declutter=&Apache::lonnet::declutter($env{'request.filename'});      my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
               my $baseurl = &Apache::lonnet::clutter($declutter);
     my @userlist;      my @userlist;
     foreach (keys %users) {      foreach (keys %users) {
  my ($user,$domain) = split(/:/, $_);   my ($user,$domain) = split(/:/, $_);
Line 1498  sub error { Line 1821  sub error {
       $cdom,$cnum);        $cdom,$cnum);
  my $now=time;   my $now=time;
  if ($now-$lastnotified{$key}>86400) {   if ($now-$lastnotified{$key}>86400) {
                       my $title = &Apache::lonnet::gettitle($symb);
                       my $sentmessage;
     &Apache::lonmsg::user_normal_msg($user,$domain,      &Apache::lonmsg::user_normal_msg($user,$domain,
  "Error [$declutter]",join('<br />',@_));          "Error [$title]",$msg,'',$baseurl,'','',
                           \$sentmessage,$symb,$title,1);
     &Apache::lonnet::put('nohist_xmlerrornotifications',      &Apache::lonnet::put('nohist_xmlerrornotifications',
  {$key => $now},   {$key => $now},
  $cdom,$cnum);   $cdom,$cnum);
Line 1562  sub get_param { Line 1888  sub get_param {
     }      }
     if ( ! $args ) { return undef; }      if ( ! $args ) { return undef; }
     if ( $case_insensitive ) {      if ( $case_insensitive ) {
  if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {   if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                      $safeeval); #'                                       $safeeval); #'
  } else {   } else {
     return undef;      return undef;
  }   }
     } else {      } else {
  if ( $args =~ /my \$\Q$param\E=\"/ ) {   if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                      $safeeval); #'                                       $safeeval); #'
  } else {   } else {
Line 1588  sub get_param_var { Line 1914  sub get_param_var {
   }    }
   &Apache::lonxml::debug("Args are $args param is $param");    &Apache::lonxml::debug("Args are $args param is $param");
   if ($case_insensitive) {    if ($case_insensitive) {
       if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {        if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
   return undef;    return undef;
       }        }
   } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }    } elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; }
   my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'    my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
   &Apache::lonxml::debug("first run is $value");    &Apache::lonxml::debug("first run is $value");
   if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {    if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
Line 1607  sub get_param_var { Line 1933  sub get_param_var {
   }    }
 }  }
   
 sub register_insert {  sub register_insert_xml {
   my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');      my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
   my $i;       .'/insertlist.xml');
   my $tagnum=0;      my ($tagnum,$in_help)=(0,0);
   my @order;      my @alltags;
   for ($i=0;$i < $#data; $i++) {      my $tag;
     my $line = $data[$i];      while (my $token = $parser->get_token()) {
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }   if ($token->[0] eq 'S') {
     if ( $line =~ /TABLE/ ) { last; }      my $key;
     my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);      if      ($token->[1] eq 'tag') {
     if ($tag) {   $tag = $token->[2]{'name'};
       $insertlist{"$tagnum.tag"} = $tag;   $insertlist{"$tagnum.tag"} = $tag;
       $insertlist{"$tagnum.description"} = $descrip;   $insertlist{"$tag.num"}   = $tagnum;
       $insertlist{"$tagnum.color"} = $color;   push(@alltags,$tag);
       $insertlist{"$tagnum.function"} = $function;      } elsif ($in_help && $token->[1] eq 'file') {
       if (!defined($show)) { $show='yes'; }   $key = $tag.'.helpfile';
       $insertlist{"$tagnum.show"}= $show;      } elsif ($in_help && $token->[1] eq 'description') {
       $insertlist{"$tagnum.helpfile"} = $helpfile;   $key = $tag.'.helpdesc';
       $insertlist{"$tagnum.helpdesc"} = $helpdesc;      } elsif ($token->[1] eq 'description' ||
       $insertlist{"$tag.num"}=$tagnum;       $token->[1] eq 'color'       ||
       $tagnum++;       $token->[1] eq 'show'          ) {
    $key = $tag.'.'.$token->[1];
       } elsif ($token->[1] eq 'insert_sub') {
    $key = $tag.'.function';
       } elsif ($token->[1] eq 'help') {
    $in_help=1;
       } elsif ($token->[1] eq 'allow') {
    $key = $tag.'.allow';
       }
       if (defined($key)) {
    $insertlist{$key} = $parser->get_text();
    $insertlist{$key} =~ s/(^\s*|\s*$ )//gx;
       }
    } elsif ($token->[0] eq 'E') {
       if      ($token->[1] eq 'tag') {
    undef($tag);
    $tagnum++;
       } elsif ($token->[1] eq 'help') {
    undef($in_help);
       }
    }
     }      }
   }      
   $i++; #skipping TABLE line      # parse the allows and ignore tags set to <show>no</show>
   $tagnum = 0;      foreach my $tag (@alltags) {
   for (;$i < $#data;$i++) {          next if (!exists($insertlist{"$tag.allow"}));
     my $line = $data[$i];   my $allow =  $insertlist{"$tag.allow"};
     my ($mnemonic,@which) = split(/ +/,$line);          foreach my $element (split(',',$allow)) {
     my $tag = $insertlist{"$tagnum.tag"};      $element =~ s/(^\s*|\s*$ )//gx;
     for (my $j=0;$j <=$#which;$j++) {      if (!exists($insertlist{"$element.show"})
       if ( $which[$j] eq 'Y' ) {                  || $insertlist{"$element.show"} ne 'no') {
  if ($insertlist{"$j.show"} ne 'no') {   push(@{ $insertlist{$tag.'.which'} },$element);
   push(@{ $insertlist{"$tag.which"} },$j);      }
  }   }
       }  
     }      }
     $tagnum++;  }
   }  
   sub register_insert {
       return &register_insert_xml(@_);
   #    &dump_insertlist('2');
   }
   
   sub dump_insertlist {
       my ($ext) = @_;
       open(XML,">/tmp/insertlist.xml.$ext");
       print XML ("<insertlist>");
       my $i=0;
   
       while (exists($insertlist{"$i.tag"})) {
    my $tag = $insertlist{"$i.tag"};
    print XML ("
   \t<tag name=\"$tag\">");
    if (defined($insertlist{"$tag.description"})) {
       print XML ("
   \t\t<description>".$insertlist{"$tag.description"}."</description>");
    }
    if (defined($insertlist{"$tag.color"})) {
       print XML ("
   \t\t<color>".$insertlist{"$tag.color"}."</color>");
    }
    if (defined($insertlist{"$tag.function"})) {
       print XML ("
   \t\t<insert_sub>".$insertlist{"$tag.function"}."</insert_sub>");
    }
    if (defined($insertlist{"$tag.show"})
       && $insertlist{"$tag.show"} ne 'yes') {
       print XML ("
   \t\t<show>".$insertlist{"$tag.show"}."</show>");
    }
    if (defined($insertlist{"$tag.helpfile"})) {
       print XML ("
   \t\t<help>
   \t\t\t<file>".$insertlist{"$tag.helpfile"}."</file>");
       if ($insertlist{"$tag.helpdesc"} ne '') {
    print XML ("
   \t\t\t<description>".$insertlist{"$tag.helpdesc"}."</description>");
       }
       print XML ("
   \t\t</help>");
    }
    if (defined($insertlist{"$tag.which"})) {
       print XML ("
   \t\t<allow>".join(',',sort(@{ $insertlist{"$tag.which"} }))."</allow>");
    }
    print XML ("
   \t</tag>");
    $i++;
       }
       print XML ("\n</insertlist>\n");
       close(XML);
 }  }
   
 sub description {  sub description {
   my ($token)=@_;      my ($token)=@_;
   my $tagnum;      my $tag = &get_tag($token);
   my $tag=$token->[1];      return $insertlist{$tag.'.description'};
   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'};  
 }  }
   
 # Returns a list containing the help file, and the description  # Returns a list containing the help file, and the description
 sub helpinfo {  sub helpinfo {
   my ($token)=@_;      my ($token)=@_;
   my $tagnum;      my $tag = &get_tag($token);
   my $tag=$token->[1];      return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
   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.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});  
 }  }
   
 # ----------------------------------------------------------------- whichuser  sub get_tag {
 # returns a list of $symb, $courseid, $domain, $name that is correct for      my ($token)=@_;
 # calls to lonnet functions for this setup.      my $tagnum;
 # - looks for form.grade_ parameters      my $tag=$token->[1];
 sub whichuser {      foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
   my ($passedsymb)=@_;   my $testtag = $namespace.'::'.$tag;
   my ($symb,$courseid,$domain,$name,$publicuser);   $tagnum = $insertlist{"$testtag.num"};
   if (defined($env{'form.grade_symb'})) {   last if (defined($tagnum));
       my ($tmp_courseid)=      }
   &Apache::loncommon::get_env_multiple('form.grade_courseid');      if (!defined($tagnum)) {
       my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);   $tagnum = $Apache::lonxml::insertlist{"$tag.num"};
       if (!$allowed &&       }
   exists($env{'request.course.sec'}) &&       return $insertlist{"$tagnum.tag"};
   $env{'request.course.sec'} !~ /^\s*$/) {  
   $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid.  
     '/'.$env{'request.course.sec'});  
       }  
       if ($allowed) {  
   ($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');  
   $courseid=$tmp_courseid;  
   ($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');  
   ($name)=&Apache::loncommon::get_env_multiple('form.grade_username');  
   return ($symb,$courseid,$domain,$name,$publicuser);  
       }  
   }  
   if (!$passedsymb) {  
       $symb=&Apache::lonnet::symbread();  
   } else {  
       $symb=$passedsymb;  
   }  
   $courseid=$env{'request.course.id'};  
   $domain=$env{'user.domain'};  
   $name=$env{'user.name'};  
   if ($name eq 'public' && $domain eq 'public') {  
       if (!defined($env{'form.username'})) {  
   $env{'form.username'}.=time.rand(10000000);  
       }  
       $name.=$env{'form.username'};  
   }  
   return ($symb,$courseid,$domain,$name,$publicuser);  
 }  }
   
 1;  1;
Removed from v.1.384  
changed lines
  Added in v.1.470

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