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

Diff for /loncom/xml/lonxml.pm between versions 1.414 and 1.551

version 1.414, 2006/07/03 10:34:30 version 1.551, 2014/12/15 17:39:24
Line 37 Line 37
 # to any other parties under any circumstances.  # to any other parties under any circumstances.
 #  #
   
   =pod
   
   =head1 NAME
   
   Apache::lonxml
   
   =head1 SYNOPSIS
   
   XML Parsing Module
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   
   =head1 SUBROUTINES
   
   =cut
   
   
   
 package Apache::lonxml;   package Apache::lonxml; 
 use vars   use vars 
 qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);  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 88  use Apache::loncommon(); Line 108  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::lonr();
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::lonhtmlcommon();
   use Apache::functionplotresponse();
   use Apache::lonnavmaps();
   
   #====================================   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 117  $metamode = 0; Line 144  $metamode = 0;
 # turns on and of run::evaluate actually derefencing var refs  # turns on and of run::evaluate actually derefencing var refs
 $evaluate = 1;  $evaluate = 1;
   
 # data structure for eidt mode, determines what tags can go into what other tags  # data structure for edit mode, determines what tags can go into what other tags
 %insertlist=();  %insertlist=();
   
 # stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
   # stores all Scrit Vars displays for later showing
   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 130  $Apache::lonxml::request=''; Line 160  $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 171  sub xmlend { Line 211  sub xmlend {
     my $discussion;      my $discussion;
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
    ['LONCAPA_INTERNAL_no_discussion']);     ['LONCAPA_INTERNAL_no_discussion']);
     if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) ||      if (
         $env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {             (   (!exists($env{'form.LONCAPA_INTERNAL_no_discussion'})) 
               || ($env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true')
              ) 
           && ($env{'form.inhibitmenu'} ne 'yes')
          ) {
         $discussion=&Apache::lonfeedback::list_discussion($mode,$status);          $discussion=&Apache::lonfeedback::list_discussion($mode,$status);
     }      }
     if ($target eq 'tex') {      if ($target eq 'tex') {
Line 184  sub xmlend { Line 228  sub xmlend {
     return $discussion;      return $discussion;
 }  }
   
 sub tokeninputfield {  
     my $defhost=$Apache::lonnet::perlvar{'lonHostID'};  
     $defhost=~tr/a-z/A-Z/;  
     return (<<ENDINPUTFIELD)  
 <script type="text/javascript">  
     function updatetoken() {  
  var comp=new Array;  
         var barcode=unescape(document.tokeninput.barcode.value);  
         comp=barcode.split('*');  
         if (typeof(comp[0])!="undefined") {  
     document.tokeninput.codeone.value=comp[0];  
  }  
         if (typeof(comp[1])!="undefined") {  
     document.tokeninput.codetwo.value=comp[1];  
  }  
         if (typeof(comp[2])!="undefined") {  
             comp[2]=comp[2].toUpperCase();  
     document.tokeninput.codethree.value=comp[2];  
  }  
         document.tokeninput.barcode.value='';  
     }    
 </script>  
 <form method="post" name="tokeninput">  
 <table border="2" bgcolor="#FFFFBB">  
 <tr><th>DocID Checkin</th></tr>  
 <tr><td>  
 <table>  
 <tr>  
 <td>Scan in Barcode</td>  
 <td><input type="text" size="22" name="barcode"   
 onChange="updatetoken()"/></td>  
 </tr>  
 <tr><td><i>or</i> Type in DocID</td>  
 <td>  
 <input type="text" size="5" name="codeone" />  
 <b><font size="+2">*</font></b>  
 <input type="text" size="5" name="codetwo" />  
 <b><font size="+2">*</font></b>  
 <input type="text" size="10" name="codethree" value="$defhost"   
 onChange="this.value=this.value.toUpperCase()" />  
 </td></tr>  
 </table>  
 </td></tr>  
 <tr><td><input type="submit" value="Check in DocID" /></td></tr>  
 </table>  
 </form>  
 ENDINPUTFIELD  
 }  
   
 sub maketoken {  
     my ($symb,$tuname,$tudom,$tcrsid)=@_;  
     unless ($symb) {  
  $symb=&Apache::lonnet::symbread();  
     }  
     unless ($tuname) {  
  $tuname=$env{'user.name'};  
         $tudom=$env{'user.domain'};  
         $tcrsid=$env{'request.course.id'};  
     }  
   
     return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);  
 }  
   
 sub printtokenheader {  
     my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;  
     unless ($token) { return ''; }  
   
     my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();  
     unless ($tsymb) {  
  $tsymb=$symb;  
     }  
     unless ($tuname) {  
  $tuname=$name;  
         $tudom=$domain;  
         $tcrsid=$courseid;  
     }  
   
     my $plainname=&Apache::loncommon::plainname($tuname,$tudom);  
   
     if ($target eq 'web') {  
         my %idhash=&Apache::lonnet::idrget($tudom,($tuname));  
  return   
  '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.  
                &mt('Checked out for').' '.$plainname.  
                '<br />'.&mt('User').': '.$tuname.' at '.$tudom.  
        '<br />'.&mt('ID').': '.$idhash{$tuname}.  
        '<br />'.&mt('CourseID').': '.$tcrsid.  
        '<br />'.&mt('Course').': '.$env{'course.'.$tcrsid.'.description'}.  
                '<br />'.&mt('DocID').': '.$token.  
                '<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';  
     } else {  
         return $token;  
     }  
 }  
   
 sub printalltags {  sub printalltags {
   my $temp;      foreach my $temp (sort(keys(%Apache::lonxml::alltags))) {
   foreach $temp (sort keys %Apache::lonxml::alltags) {          &Apache::lonxml::debug("$temp -- ".
     &Apache::lonxml::debug("$temp -- ".                                 join(',',@{ $Apache::lonxml::alltags{$temp} }));
   join(',',@{ $Apache::lonxml::alltags{$temp} }));      }
   }  
 }  }
   
 sub xmlparse {  sub xmlparse {
Line 314  sub xmlparse { Line 262  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 342  sub xmlparse { Line 291  sub xmlparse {
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    $safeeval,\%style_for_target,1);     $safeeval,\%style_for_target,1);
   
    if (@stack) {
        &warning(&mt('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'});
  }   }
Line 350  sub xmlparse { Line 304  sub xmlparse {
   
  &clean_safespace($safeeval);   &clean_safespace($safeeval);
   
    if (@script_var_displays) {
        if ($finaloutput =~ m{</body>\s*</html>\s*$}s) {
            my $scriptoutput = join('',@script_var_displays);
            $finaloutput=~s{(</body>\s*</html>)\s*$}{$scriptoutput$1}s;
        } else {
            $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'}) {
        if ($env{'request.filename'}=~/\.(html|htm|xml)$/i) { 
           my $error=&verify_html($content_file_string);
           if ($error) { $errorcount++; }
        }
      return "$errorcount:$warningcount";       return "$errorcount:$warningcount";
  }   }
  return $finaloutput;   return $finaloutput;
Line 367  sub latex_special_symbols { Line 335  sub latex_special_symbols {
     }      }
     if ($where eq 'header') {      if ($where eq 'header') {
  $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.   $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
  $string =~ s/_/\\_/g;              # _ -> \_  
  $string =~ s/\^/\\\^{}/g;          # ^ -> \^{}   
  $string =~ s/(\$|%|\{|\})/\\$1/g;   $string =~ s/(\$|%|\{|\})/\\$1/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 454  sub inner_xmlparse { Line 422  sub inner_xmlparse {
     while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {      while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
  my $lasttag=$$stack[-1];   my $lasttag=$$stack[-1];
  if ($token->[1] =~ /^\Q$lasttag\E$/i) {   if ($token->[1] =~ /^\Q$lasttag\E$/i) {
     &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' as end tag to &lt;'.$$stack[-1].'&gt;');      &Apache::lonxml::warning(&mt('Using tag [_1] on line [_2] as end tag to [_3]','&lt;/'.$token->[1].'&gt;','.$token->[3].','&lt;'.$$stack[-1].'&gt;'));
     last;      last;
  } else {   } else {
     &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' when looking for &lt;/'.$$stack[-1].'&gt; in file');                      &Apache::lonxml::warning(&mt('Found tag [_1] on line [_2] when looking for [_3] in file.','&lt;/'.$token->[1].'&gt;',$token->[3],'&lt;/'.$$stack[-1].'&gt;'));
     &end_tag($stack,$parstack,$token);      &end_tag($stack,$parstack,$token);
  }   }
     }      }
Line 473  sub inner_xmlparse { Line 441  sub inner_xmlparse {
   if (!$Apache::lonxml::usestyle) {    if (!$Apache::lonxml::usestyle) {
       $extras=$Apache::lonxml::style_values;        $extras=$Apache::lonxml::style_values;
   }    }
  if ( $#$parstack > -1 ) {    if ( $#$parstack > -1 ) {
   $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);        $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
  } else {    } else {
   $result= &Apache::run::evaluate($result,$safeeval,$extras);        $result= &Apache::run::evaluate($result,$safeeval,$extras);
  }            }
       }        }
       $Apache::lonxml::post_evaluate=1;        $Apache::lonxml::post_evaluate=1;
   
Line 518  sub inner_xmlparse { Line 486  sub inner_xmlparse {
   }    }
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
     }
     if ($target eq 'modified') {
   # if modfied, handle startpart and endpart
        $finaloutput=~s/\<startpartmarker[^\>]*\>(.*)\<endpartmarker[^\>]*\>/<part>$1<\/part>/gs;
   }        }    
   return $finaloutput;    return $finaloutput;
 }  }
Line 544  sub callsub { Line 516  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 580  sub callsub { Line 551  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 598  sub callsub { Line 575  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;
   $errorcount=0;    $errorcount=0;
   $warningcount=0;    $warningcount=0;
     $Apache::lonxml::internal_error=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='';
Line 652  sub setup_globals { Line 652  sub setup_globals {
   
 sub init_safespace {  sub init_safespace {
   my ($target,$safeeval,$safehole,$safeinit) = @_;    my ($target,$safeeval,$safehole,$safeinit) = @_;
     $safeeval->reval('use LaTeX::Table;');
   $safeeval->deny_only(':dangerous');    $safeeval->deny_only(':dangerous');
   $safeeval->reval('use Math::Complex;');    $safeeval->reval('use LONCAPA::LCMathComplex;');
   $safeeval->permit_only(":default");    $safeeval->permit_only(":default");
   $safeeval->permit("entereval");    $safeeval->permit("entereval");
   $safeeval->permit(":base_math");    $safeeval->permit(":base_math");
   $safeeval->permit("sort");    $safeeval->permit("sort");
   $safeeval->permit("time");    $safeeval->permit("time");
     $safeeval->permit("caller");
   $safeeval->deny("rand");    $safeeval->deny("rand");
   $safeeval->deny("srand");    $safeeval->deny("srand");
   $safeeval->deny(":base_io");    $safeeval->deny(":base_io");
Line 668  sub init_safespace { Line 670  sub init_safespace {
   $safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,    $safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,
   '&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::response::implicit_multiplication,$safeeval,'&implicit_multiplication');
   
     $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::lonr::r_eval,$safeeval,'&r_eval');
     $safehole->wrap(\&Apache::lonr::Rentry,$safeeval,'&Rentry');
     $safehole->wrap(\&Apache::lonr::Rarray,$safeeval,'&Rarray');
     $safehole->wrap(\&Apache::lonr::r_check,$safeeval,'&r_check');
     $safehole->wrap(\&Apache::lonr::r_cas_formula_fix,$safeeval,
                     '&r_cas_formula_fix');
    
     $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval,
     '&capa_formula_fix');
   
     $safehole->wrap(\&Apache::lonlocal::locallocaltime,$safeeval,
                     '&locallocaltime');
   
   $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');
Line 770  sub init_safespace { Line 791  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');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_val,$safeeval,'&fpr_val');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_f,$safeeval,'&fpr_f');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_dfdx,$safeeval,'&fpr_dfdx');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_d2fdx2,$safeeval,'&fpr_d2fdx2');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorcoords,$safeeval,'&fpr_vectorcoords');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_objectcoords,$safeeval,'&fpr_objectcoords');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorlength,$safeeval,'&fpr_vectorlength');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorangle,$safeeval,'&fpr_vectorangle');
   
   #  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 813  sub delete_package_recurse { Line 847  sub delete_package_recurse {
 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 823  sub initialize_rndseed { Line 857  sub initialize_rndseed {
 sub default_homework_load {  sub default_homework_load {
     my ($safeeval)=@_;      my ($safeeval)=@_;
     &Apache::lonxml::debug('Loading default_homework');      &Apache::lonxml::debug('Loading default_homework');
     my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');      my $default=&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonIncludes'}.
                                            '/default_homework.lcpm');
     if ($default eq -1) {      if ($default eq -1) {
  &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");   &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
     } else {      } else {
Line 875  sub endredirection { Line 910  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 885  sub end_tag { Line 923  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 {  sub get_id {
     my ($parstack,$safeeval)=@_;      my ($parstack,$safeeval)=@_;
     my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);      my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
     if ($env{'request.state'} eq 'construct' && $id =~ /(\.|_)/) {      if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\d\s[:punct:]])/) {
  &error(&mt("IDs are not allowed to contain &quot;<tt>_</tt>&quot; or &quot;<tt>.</tt>&quot;"));   &error(&mt('ID [_1] contains invalid characters. IDs are only allowed to contain letters, numbers, spaces and -','"<tt>'.$id.'</tt>"'));
     }      }
     if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }      if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
     return $id;      return $id;
Line 973  sub get_all_text_unbalanced { Line 1010  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, $part_response);
   
   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 ($env{'form.grade_noincrement'}) { return; }
  $Apache::lonxml::counter+=$increment;      if (!defined($increment) || $increment le 0) {
     } else {   $increment = 1;
  $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 ($env{'request.state'} eq 'construct') {      if ($env{'request.state'} eq 'construct') {
  $Apache::lonxml::counter=1;   $Apache::lonxml::counter=1;
Line 999  sub init_counter { Line 1085  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;      $Apache::lonxml::counter_changed=0;
     return '';      return '';
 }  }
Line 1014  sub store_counter { Line 1100  sub store_counter {
     }      }
   
     sub remember_problem_counter {      sub remember_problem_counter {
  &Apache::lonnet::transfer_profile_to_env();   &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
  $state = $env{'form.counter'};   $state = $env{'form.counter'};
     }      }
   
     sub restore_problem_counter {      sub restore_problem_counter {
  if (defined($state)) {   if (defined($state)) {
     &Apache::lonnet::appenv(('form.counter' => $state));      &Apache::lonnet::appenv({'form.counter' => $state});
  }   }
     }      }
     sub get_problem_counter {      sub get_problem_counter {
  if ($Apache::lonxml::counter_changed) { &store_counter() }   if ($Apache::lonxml::counter_changed) { &store_counter() }
  &Apache::lonnet::transfer_profile_to_env();   &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
  return $env{'form.counter'};   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 1149  sub newparser { Line 1302  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 1169  sub extlink { Line 1326  sub extlink {
     if (!$exact) {      if (!$exact) {
  $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res);   $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res);
     }      }
     push(@Apache::lonxml::extlinks,$res)        push(@Apache::lonxml::extlinks,$res);
 }  }
   
 sub writeallows {  sub writeallows {
Line 1183  sub writeallows { Line 1340  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);
 }  }
   
 sub register_ssi {  sub register_ssi {
Line 1202  sub do_registered_ssi { Line 1359  sub do_registered_ssi {
  &Apache::lonnet::ssi($url,%form);   &Apache::lonnet::ssi($url,%form);
     }      }
 }  }
   
   sub add_script_result {
       my ($display) = @_;
       if ($display ne '') {
           push(@script_var_displays, $display);
       }
   }
   
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
Line 1247  sub storefile { Line 1412  sub storefile {
         $fh->close();          $fh->close();
         return 1;          return 1;
     } else {      } else {
  &warning("Unable to save file $file");   &warning(&mt('Unable to save file [_1]','<tt>'.$file.'</tt>'));
  return 0;   return 0;
     }      }
 }  }
Line 1280  SIMPLECONTENT Line 1445  SIMPLECONTENT
   return $filecontents;    return $filecontents;
 }  }
   
   sub createnewjs {
       my $filecontents=(<<SIMPLECONTENT);
   <script type="text/javascript" language="Javascript">
   
   </script>
   SIMPLECONTENT
       return $filecontents;
   }
   
   sub verify_html {
       my ($filecontents)=@_;
       my ($is_html,$is_xml);
       if ($filecontents =~/(?:\<|\&lt\;)\?xml[^\<]*\?(?:\>|\&gt\;)/is) {
           $is_xml = 1;
       } elsif ($filecontents =~/(?:\<|\&lt\;)html(?:\s+[^\<]+|\s*)(?:\>|\&gt\;)/is) {
           $is_html = 1;
       }
       unless ($is_xml || $is_html) {
           return &mt('File does not have [_1] or [_2] starting tag','&lt;html&gt;','&lt;?xml ?&gt;');
       }
       if ($is_html) {
           if ($filecontents!~/(?:\<|\&lt\;)\/html(?:\>|\&gt\;)/is) {
               return &mt('File does not have [_1] ending tag','&lt;html&gt;');
           }
           if ($filecontents!~/(?:\<|\&lt\;)(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) {
               return &mt('File does not have [_1] or [_2] starting tag','&lt;body&gt;','&lt;frameset&gt;');
           }
           if ($filecontents!~/(?:\<|\&lt\;)\/(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) {
               return &mt('File does not have [_1] or [_2] ending tag','&lt;body&gt;','&lt;frameset&gt;');
           }
       }
       return '';
   }
   
   sub renderingoptions {
       my %langchoices=('' => '');
       foreach (&Apache::loncommon::languageids()) {
           if (&Apache::loncommon::supportedlanguagecode($_)) {
               $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
                          = &Apache::loncommon::plainlanguagedescription($_);
           }
       }
       my $output;
       unless ($env{'form.forceedit'}) {
          $output .=
              '<span class="LC_nobreak">'.
              &mt('Language:').' '.
              &Apache::loncommon::select_form(
                  $env{'form.languages'},
                  'languages',
                  {&Apache::lonlocal::texthash(%langchoices)}).
              '</span>';
       }
       $output .=
        ' <span class="LC_nobreak">'.
          &mt('Math Rendering:').' '.
          &Apache::loncommon::select_form(
              $env{'form.texengine'},
              'texengine',
              {&Apache::lonlocal::texthash
                  (''        => '',
                   'tth'     => 'tth (TeX to HTML)',
                   'MathJax' => 'MathJax',
     'jsMath'  => 'jsMath',
                   'mimetex' => 'mimetex (Convert to Images)')}).
        '</span>';
       return $output;
   }
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents,$filetype)=@_;        my ($filecontents,$filetype,$filename,$symb,$itemtitle,$folderpath,$uri,$action) = @_;
       $filecontents = &HTML::Entities::encode($filecontents,'<>&"');        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';  
       my $xml_help = '';        my $xml_help = '';
       my $initialize='';        my $initialize='';
         my $textarea_id = 'filecont';
         my ($dragmath_button,$deps_button,$context,$cnum,$cdom,$add_to_onload,
             $add_to_onresize,$init_dragmath);
         $initialize=&Apache::lonhtmlcommon::spellheader();
       if ($filetype eq 'html') {        if ($filetype eq 'html') {
   my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();            if ($env{'request.course.id'}) {
   $initialize=&Apache::lonhtmlcommon::spellheader();                $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
   if (!&Apache::lonhtmlcommon::htmlareablocked() &&                $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       &Apache::lonhtmlcommon::htmlareabrowser()) {                if ($uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E}) {
       $initialize.=(<<FULLPAGE);                    $context = 'syllabus';
 <script type="text/javascript">                }
 $addbuttons            }
             if (&Apache::lonhtmlcommon::htmlareabrowser()) {
     HTMLArea.loadPlugin("FullPage");        my $lang = &Apache::lonhtmlcommon::htmlarea_lang();
                 my %textarea_args = (
     function initDocument() {                                      fullpage => 'true',
  var editor=new HTMLArea("filecont",config);                                      dragmath => 'math',
  editor.registerPlugin(FullPage);                                    );
  editor.generate();                $initialize .= &Apache::lonhtmlcommon::htmlareaselectactive(\%textarea_args);
     }                if ($context eq 'syllabus') {
 </script>                    $init_dragmath = "editmath_visibility('filecont','none')";
 FULLPAGE                }
           } else {            }
       $initialize.=(<<FULLPAGE);        }
         $initialize .= (<<FULLPAGE);
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  // <![CDATA[
     function initDocument() {      function initDocument() {
    resize_textarea('$textarea_id','LC_aftertextarea');
           $init_dragmath
     }      }
   // ]]>
 </script>  </script>
 FULLPAGE  FULLPAGE
   }        my $textareaclass;
           $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;        if ($filetype eq 'html') {
   $xml_help=&Apache::loncommon::helpLatexCheatsheet();            if ($context eq 'syllabus') {
                 $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n";
                 $initialize .=
                     &Apache::lonhtmlcommon::dependencycheck_js(undef,&mt('Syllabus'),
                                                                $uri,undef,
                                                                "/public/$cdom/$cnum/syllabus").
                     "\n";
                 if (&Apache::lonhtmlcommon::htmlareabrowser()) {
                     $textareaclass = 'class="LC_richDefaultOn"';
                 }
             } elsif ($symb || $folderpath) {
                 $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n";
                 $initialize .= 
                     &Apache::lonhtmlcommon::dependencycheck_js($symb,$itemtitle,
                                                                undef,$folderpath,$uri)."\n";
             }
             $dragmath_button = '<span id="math_filecont">'.&Apache::lonhtmlcommon::dragmath_button('filecont',1).'</span>';
             $initialize .= "\n".&Apache::lonhtmlcommon::dragmath_js('EditMathPopup');
         }
         $add_to_onload = 'initDocument();';
         $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";
   
         if ($filetype eq 'html') {
             my $not_author;
             if ($uri =~ m{^/uploaded/}) {
                 $not_author = 1;
             }
     $xml_help=&Apache::loncommon::helpLatexCheatsheet(undef,undef,$not_author);
       }        }
       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'}" />        my $htmlerror;
 BUTTONS        if ($filetype eq 'html') {
       $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');            $htmlerror=&verify_html($filecontents);
       $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');            if ($htmlerror) {
                 $htmlerror='<span class="LC_error">'.$htmlerror.'</span>';
             }
             if (&Apache::lonhtmlcommon::htmlareabrowser()) {
                 unless ($textareaclass) {
                     $textareaclass = 'class="LC_richDefaultOff"';
                 }
             }
         }
         my $undo;
         unless ($uri =~ m{^/uploaded/}) {
             $undo = '<input type="submit" name="Undo" accesskey="u" value="'.$lt{'un'}.'" />'."\n";
         }
       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" action="$action">
 $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'}" />
         $undo $htmlerror $deps_button $dragmath_button
       </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" $textareaclass>$filecontents</textarea><br />$spelllink
     <div id="LC_aftertextarea">
       <br />
       $titledisplay
     </div>
 </form>  </form>
 $titledisplay  
 </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 1379  sub get_target { Line 1669  sub get_target {
   
 sub handler {  sub handler {
     my $request=shift;      my $request=shift;
       
     my $target=&get_target();      my $target=&get_target();
       
     $Apache::lonxml::debug=$env{'user.debug'};      $Apache::lonxml::debug=$env{'user.debug'};
           
     &Apache::loncommon::content_type($request,'text/html');      &Apache::loncommon::content_type($request,'text/html');
Line 1390  sub handler { Line 1679  sub handler {
  $request->set_last_modified(&Apache::lonnet::metadata($request->uri,   $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
       'lastrevisiondate'));        'lastrevisiondate'));
     }      }
       # Embedded Flash movies from Camtasia served from https will not display in IE
       #   if XML config file has expired from cache.    
       if ($ENV{'SERVER_PORT'} == 443) {
           if ($request->uri =~ /\.xml$/) {
               my ($httpbrowser,$clientbrowser) =
                   &Apache::loncommon::decode_user_agent($request);
               if ($clientbrowser =~ /^explorer$/i) {
                   delete $request->headers_out->{'Cache-control'};
                   delete $request->headers_out->{'Pragma'};
                   my $expiration = time + 60;
                   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime($expiration));
                   $request->headers_out->set("Expires" => $date);
               }
           }
       }
     $request->send_http_header;      $request->send_http_header;
           
     return OK if $request->header_only;      return OK if $request->header_only;
   
   
     my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
     my $filetype;      my ($filetype,$breadcrumbtext);
     if ($file =~ /\.sty$/) {      if ($file =~ /\.(sty|css|js|txt|tex)$/) {
  $filetype='sty';   $filetype=$1;
     } else {      } else {
  $filetype='html';   $filetype='html';
     }      }
       unless ($env{'request.uri'}) {
           $env{'request.uri'}=$request->uri;
           &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                                   ['todocs']);
       }
       my ($cdom,$cnum);
       if ($env{'request.course.id'}) {
           $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           if ($filetype eq 'html') {
               if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E.+$}) {
                   if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
                       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                                               ['editmode']);
                   }
               }
           }
       }
       if ($filetype eq 'sty') {
           $breadcrumbtext = 'Style File Editor';
       } elsif ($filetype eq 'js') {
           $breadcrumbtext = 'Javascript Editor';
       } elsif ($filetype eq 'css') {
           $breadcrumbtext = 'CSS Editor';
       } elsif ($filetype eq 'txt') {
           $breadcrumbtext = 'Text Editor';
       } elsif ($filetype eq 'tex') {
           $breadcrumbtext = 'TeX Editor';
       } else {
           $breadcrumbtext = 'HTML Editor';
       }
   
 #  #
 # 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').": ".              if ($env{'form.savethisfile'}) {
       &Apache::lonlocal::locallocaltime(time).                  $env{'form.editmode'}='Edit'; #force edit mode
       " </font>");              }
     }   
  }   }
     }      }
       my $inhibit_menu;
     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 $start_page=&Apache::loncommon::start_page('File Error');   my $start_page=&Apache::loncommon::start_page('File Error');
  my $end_page=&Apache::loncommon::end_page();   my $end_page=&Apache::loncommon::end_page();
  my $fnf=&mt('File not found');          my $errormsg='<p class="LC_error">'
                       .&mt('File not found: [_1]'
                           ,'<span class="LC_filename">'.$file.'</span>')
                       .'</p>';
  $result=(<<ENDNOTFOUND);   $result=(<<ENDNOTFOUND);
 $start_page  $start_page
 <b>$fnf: $file</b>  $errormsg
 $end_page  $end_page
 ENDNOTFOUND  ENDNOTFOUND
         $filecontents='';          $filecontents='';
  if ($env{'request.state'} ne 'published') {   if ($env{'request.state'} ne 'published') {
     if ($filetype eq 'sty') {      if ($filetype eq 'sty') {
  $filecontents=&createnewsty();   $filecontents=&createnewsty();
     } else {              } elsif ($filetype eq 'js') {
                   $filecontents=&createnewjs();
               } elsif ($filetype ne 'css' && $filetype ne 'txt' && $filetype ne 'tex') {
  $filecontents=&createnewhtml();   $filecontents=&createnewhtml();
     }      }
     $env{'form.editmode'}='Edit'; #force edit mode      $env{'form.editmode'}='Edit'; #force edit mode
Line 1446  ENDNOTFOUND Line 1787  ENDNOTFOUND
             &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},              &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     ['editmode']);      ['editmode']);
  }   }
  if (!$env{'form.editmode'} || $env{'form.viewmode'}) {   if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) {
     $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,              if ($filetype eq 'html' || $filetype eq 'sty') {
  '',%mystyle);          &Apache::structuretags::reset_problem_globals();
     undef($Apache::lonhomework::parsing_a_task);          $result = &Apache::lonxml::xmlparse($request,$target,
                                                       $filecontents,'',%mystyle);
       # .html files may contain <problem> or <Task> need to clean
       # up if it did
           &Apache::structuretags::reset_problem_globals();
           &Apache::lonhomework::finished_parsing();
               } elsif ($filetype eq 'tex') {
                   $result = &Apache::lontexconvert::converted(\$filecontents,
                                 $env{'form.texengine'});
                   if ($env{'form.return_only_error_and_warning_counts'}) {
                       $result = "$errorcount:$warningcount";
                   }
               } else {
                   $result = $filecontents;
               }
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     ['rawmode']);      ['rawmode']);
     if ($env{'form.rawmode'}) { $result = $filecontents; }      if ($env{'form.rawmode'}) { $result = $filecontents; }
  }              if (($env{'request.state'} eq 'construct') &&
                   (($filetype eq 'css') || ($filetype eq 'js')) && ($ENV{'HTTP_REFERER'})) {
                   if ($ENV{'HTTP_REFERER'} =~ m{^https?\://[^\/]+/priv/$LONCAPA::match_domain/$LONCAPA::match_username/[^\?]+\.(x?html?|swf)(|\?)[^\?]*$}) {
                       $inhibit_menu = 1;
                   }
               }
               if (($filetype ne 'html') && 
                   (!$env{'form.return_only_error_and_warning_counts'}) &&
                   (!$inhibit_menu)) {
                   my $nochgview = 1;
                   my $controls = '';
                       if ($env{'request.state'} eq 'construct') {
                           $controls = &Apache::loncommon::head_subbox(
                                           &Apache::loncommon::CSTR_pageheader()
                                          .&Apache::londefdef::edit_controls($nochgview));
                       }
                   if ($filetype ne 'sty' && $filetype ne 'tex') {
                       $result =~ s/</&lt;/g;
                       $result =~ s/>/&gt;/g;
                       $result = '<table class="LC_sty_begin">'.
                                 '<tr><td><b><pre>'.$result.
                                 '</pre></b></td></tr></table>';
                   }
                   my $brcrum;
                   if ($env{'request.state'} eq 'construct') {
                       $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri),
                                   'text' => 'Authoring Space'},
                                  {'href' => '',
                                   'text' => $breadcrumbtext}];
                   } else {
                       $brcrum = ''; # FIXME: Where are we?
                   }
                   my %options = ('bread_crumbs' => $brcrum,
                                  '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') || ($inhibit_menu)) {
  if ($env{'form.editmode'} && (!($env{'form.viewmode'}))) {   if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
     my $displayfile=$request->uri;   {
     $displayfile=~s/^\/[^\/]*//;              my ($displayfile,$url,$symb,$itemtitle,$action);
     my %options = ();      $displayfile=$request->uri;
     if ($env{'environment.remote'} ne 'off') {              if ($request->uri =~ m{^/uploaded/}) {
  $options{'bgcolor'}   = '#FFFFFF';                  if ($env{'request.course.id'}) {
     }                      if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/supplemental/\E}) {
     my $start_page = &Apache::loncommon::start_page(undef,undef,                          &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                                                   ['folderpath','title']);
                       } elsif ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E(.+)$}) {
                           my $filename = $1;
                           if ($1 eq 'loncapa.html') {
                               $displayfile = &mt('Syllabus (minimal template)');
                               $action = $request->uri.'?forceedit=1';
                           } else {
                               $displayfile = &mt('Syllabus file: [_1]',$1);
                           }
                           $itemtitle = &mt('Syllabus');
                       }
                   }
                   unless ($itemtitle) {
                       ($symb,$itemtitle,$displayfile) = 
                           &get_courseupload_hierarchy($request->uri,
                                                       $env{'form.folderpath'},
                                                       $env{'form.title'});
                   }
               } else {
           $displayfile=~s/^\/[^\/]*//;
               }
   
       my ($edit_info, $add_to_onload, $add_to_onresize)=
    &inserteditinfo($filecontents,$filetype,$displayfile,$symb,
                                   $itemtitle,$env{'form.folderpath'},$request->uri,$action);
   
       my %options = 
    ('add_entries' =>
                      {'onresize'     => $add_to_onresize,
                       'onload'       => $add_to_onload,   });
               my $header;
               if ($env{'request.state'} eq 'construct') {
                   $options{'bread_crumbs'} = [{
                               'href' => &Apache::loncommon::authorspace($request->uri),
                               'text' => 'Authoring Space'},
                              {'href' => '',
                               'text' => $breadcrumbtext}];
                   $header = &Apache::loncommon::head_subbox(
                                 &Apache::loncommon::CSTR_pageheader());
               }
       my $js =
    &Apache::edit::js_change_detection().
    &Apache::loncommon::resize_textarea_js();
       my $start_page = &Apache::loncommon::start_page(undef,$js,
     \%options);      \%options);
     $result=$start_page.              $result = $start_page
  &Apache::lonxml::message_location().'<h3>'.                       .$header
  $displayfile.                       .&Apache::lonxml::message_location()
  '</h3>'.&Apache::loncommon::end_page();                       .$edit_info
     $result=&inserteditinfo($result,$filecontents,$filetype);                       .&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 1493  sub display_title { Line 1931  sub display_title {
     $title = $env{'request.filename'};      $title = $env{'request.filename'};
     $title = substr($title, rindex($title, '/') + 1);      $title = substr($title, rindex($title, '/') + 1);
  }   }
  $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA Construction Space';</script>";          $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA "
                     .&mt('Authoring Space')."';</script>";
     }      }
     return $result;      return $result;
 }  }
   
   sub get_courseupload_hierarchy {
       my ($url,$folderpath,$title) = @_;
       my ($symb,$itemtitle,$displaypath);
       if ($env{'request.course.id'}) {
           if ($folderpath =~ /^supplemental/) {
               my @folders = split(/\&/,$folderpath);
               my @pathitems;
               while (@folders) {
                   my $folder=shift(@folders);
                   my $foldername=shift(@folders);
                   $foldername =~ s/\:(\d*)\:(\w*)\:(\w*):(\d*)\:?(\d*)$//;
                   push(@pathitems,&unescape($foldername));
               }
               if ($title) {
                   push(@pathitems,&unescape($title));
               }
               $displaypath = join(' &raquo; ',@pathitems);
           } else {
               $symb = &Apache::lonnet::symbread($url);
               my ($map,$id,$res)=&Apache::lonnet::decode_symb($symb);
               my $navmap=Apache::lonnavmaps::navmap->new;
               if (ref($navmap)) {
                   my $res = $navmap->getBySymb($symb);
                   if (ref($res)) {
                       my @pathitems =
                           &Apache::loncommon::get_folder_hierarchy($navmap,$map,1);
                       $itemtitle = $res->compTitle();
                       push(@pathitems,$itemtitle);
                       $displaypath = join(' &raquo; ',@pathitems);
                   }
               }
           }
       }
       return ($symb,$itemtitle,$displaypath);
   }
   
 sub debug {  sub debug {
     if ($Apache::lonxml::debug eq "1") {      if ($Apache::lonxml::debug eq "1") {
  $|=1;   $|=1;
Line 1514  sub debug { Line 1989  sub debug {
 }  }
   
 sub show_error_warn_msg {  sub show_error_warn_msg {
     if ($env{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' &&      if (($env{'request.filename'} eq 
  &Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {           $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/lib/templates/simpleproblem.problem') &&
           (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) {
  return 1;   return 1;
     }      }
     return (($Apache::lonxml::debug eq 1) ||      return (($Apache::lonxml::debug eq 1) ||
Line 1526  sub show_error_warn_msg { Line 2002  sub show_error_warn_msg {
 }  }
   
 sub error {  sub error {
       my @errors = @_;
   
     $errorcount++;      $errorcount++;
   
       $Apache::lonxml::internal_error=1;
   
       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");               .'<div class="LC_error">'
                .'<b>'.&mt('ERROR:').' </b>'.join("<br />\n",@errors)
                ."</div>\n");
  $Apache::lonxml::warnings_error_header='';   $Apache::lonxml::warnings_error_header='';
     } else {      } else {
  my $errormsg;   my $errormsg;
  my ($symb)=&Apache::lonnet::symbread();   my ($symb)=&Apache::lonnet::symbread();
  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 occurred while processing this resource. The author has been notified.");
  }   }
  my $host=$Apache::lonnet::perlvar{'lonHostID'};   my $host=$Apache::lonnet::perlvar{'lonHostID'};
  my $msg = join('<br />',(@_,"The occured on host <tt>$host</tt>"));   push(@errors,
           &mt("The error occurred on host [_1]",
                "<tt>$host</tt>"));
   
    my $msg = join('<br />', @errors);
   
  #notify author   #notify author
  &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);   &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(/:/, $_);
  push(@userlist,"$user\@$domain");   push(@userlist,"$user:$domain");
  my $key=$declutter.'_'.$user.'_'.$domain;   my $key=$declutter.'_'.$user.'_'.$domain;
  my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',   my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
       [$key],        [$key],
       $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]",$msg);          "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);
  }   }
     }      }
     if ($env{'request.role.adv'}) {      if ($env{'request.role.adv'}) {
  $errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));   $errormsg=&mt("An error occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
     } else {      } else {
  $errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");   $errormsg=&mt("An error occurred while processing this resource. The instructor has been notified.");
     }      }
  }   }
  push(@Apache::lonxml::error_messages,"<b>$errormsg</b> <br />");   push(@Apache::lonxml::error_messages,"<span class=\"LC_warning\">$errormsg</span><br />");
     }      }
 }  }
   
Line 1583  sub warning { Line 2088  sub warning {
     if ($env{'form.grade_target'} ne 'tex') {      if ($env{'form.grade_target'} ne 'tex') {
  if ( &show_error_warn_msg() ) {   if ( &show_error_warn_msg() ) {
     push(@Apache::lonxml::warning_messages,      push(@Apache::lonxml::warning_messages,
  $Apache::lonxml::warnings_error_header.   $Apache::lonxml::warnings_error_header
  "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");                  .'<div class="LC_warning">'
                   .&mt('[_1]W[_2]ARNING','<b>','</b>')."<b>:</b> ".join('<br />',@_)
                   ."</div>\n"
                   );
     $Apache::lonxml::warnings_error_header='';      $Apache::lonxml::warnings_error_header='';
  }   }
     }      }
Line 1615  sub add_messages { Line 2123  sub add_messages {
 }  }
   
 sub get_param {  sub get_param {
     my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;      my ($param,$parstack,$safeeval,$context,$case_insensitive, $noelide) = @_;
   
     if ( ! $context ) { $context = -1; }      if ( ! $context ) { $context = -1; }
     my $args ='';      my $args ='';
     if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }      if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
     if ( ! $Apache::lonxml::usestyle ) {      if ( ! $Apache::lonxml::usestyle ) {
  $args=$Apache::lonxml::style_values.$args;   $args=$Apache::lonxml::style_values.$args;
     }      }
   
   
       if ($noelide) {
   # $args =~ s/\\'/'/g;
    $args =~ s/'\$/'\\\$/g;
       }
   
     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 1650  sub get_param_var { Line 2168  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 1669  sub get_param_var { Line 2187  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;                  if (defined($tag)) {
       $insertlist{"$tagnum.description"} = $descrip;      $insertlist{$tagnum.'.tag'} = $tag;
       $insertlist{"$tagnum.color"} = $color;      $insertlist{$tag.'.num'}   = $tagnum;
       $insertlist{"$tagnum.function"} = $function;      push(@alltags,$tag);
       if (!defined($show)) { $show='yes'; }                  }
       $insertlist{"$tagnum.show"}= $show;      } elsif ($in_help && $token->[1] eq 'file') {
       $insertlist{"$tagnum.helpfile"} = $helpfile;   $key = $tag.'.helpfile';
       $insertlist{"$tagnum.helpdesc"} = $helpdesc;      } elsif ($in_help && $token->[1] eq 'description') {
       $insertlist{"$tag.num"}=$tagnum;   $key = $tag.'.helpdesc';
       $tagnum++;      } elsif ($token->[1] eq 'description' ||
        $token->[1] eq 'color'       ||
        $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'}, &mt($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'});  ############################################################
       }  #                                           PDF-FORM-METHODS
       if ($allowed) {  
   ($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');  =pod
   $courseid=$tmp_courseid;  
   ($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');  =item &print_pdf_radiobutton(fieldname, value)
   ($name)=&Apache::loncommon::get_env_multiple('form.grade_username');  
   return ($symb,$courseid,$domain,$name,$publicuser);  Returns a latexline to generate a PDF-Form-Radiobutton.
       }  Note: Radiobuttons with equal names are automaticly grouped 
   }        in a selection-group.
   if (!$passedsymb) {  
       $symb=&Apache::lonnet::symbread();  $fieldname: PDF internalname of the radiobutton(group)
   } else {  $value:     Value of radiobutton
       $symb=$passedsymb;  
   }  =cut
   $courseid=$env{'request.course.id'};  sub print_pdf_radiobutton {
   $domain=$env{'user.domain'};      my ($fieldname, $value) = @_;
   $name=$env{'user.name'};      return '\radioButton[\symbolchoice{circle}]{'
   if ($name eq 'public' && $domain eq 'public') {             .$fieldname.'}{10bp}{10bp}{'.$value.'}';
       if (!defined($env{'form.username'})) {  }
   $env{'form.username'}.=time.rand(10000000);  
       }  
       $name.=$env{'form.username'};  =pod
   }  
   return ($symb,$courseid,$domain,$name,$publicuser);  =item &print_pdf_start_combobox(fieldname)
   
   Starts a latexline to generate a PDF-Form-Combobox with text.
   
   $fieldname: PDF internal name of the Combobox
   
   =cut
   sub print_pdf_start_combobox {
       my $result;
       my ($fieldName) = @_;
       $result .= '\begin{tabularx}{\textwidth}{p{2.5cm}X}'."\n";
       $result .= '\comboBox[]{'.$fieldName.'}{2.3cm}{14bp}{'; # 
   
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_add_combobox_option(options)
   
   Generates a latexline to add Options to a PDF-Form-ComboBox.
   
   $option: PDF internal name of the Combobox-Option
   
   =cut
   sub print_pdf_add_combobox_option {
   
       my $result;
       my ($option) = @_;  
   
       $result .= '('.$option.')';
       
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_end_combobox(text) {
   
   Returns latexcode to end a PDF-Form-Combobox with text.
   
   =cut
   sub print_pdf_end_combobox {
       my $result;
       my ($text) = @_;
   
       $result .= '}&'.$text."\\\\\n";
       $result .= '\end{tabularx}' . "\n";
       $result .= '\hspace{2mm}' . "\n";
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_hiddenField(fieldname, user, domain)
   
   Returns a latexline to generate a PDF-Form-hiddenField with userdata.
   
   $fieldname label for hiddentextfield
   $user:    name of user
   $domain:  domain of user
   
   =cut
   sub print_pdf_hiddenfield {
       my $result;
       my ($fieldname, $user, $domain) = @_;
   
       $result .= '\textField [\F{\FHidden}\F{-\FPrint}\V{'.$domain.'&'.$user.'}]{'.$fieldname.'}{0in}{0in}'."\n";
   
       return $result;
 }  }
   
 1;  1;
 __END__  __END__
   
   
Removed from v.1.414  
changed lines
  Added in v.1.551

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