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

Diff for /loncom/xml/lonxml.pm between versions 1.409 and 1.450

version 1.409, 2006/04/18 20:55:26 version 1.450, 2007/08/17 20:34:31
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 88  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  
Line 123  $evaluate = 1; Line 125  $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 254  sub printtokenheader { Line 256  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 317  sub xmlparse { Line 319  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 345  sub xmlparse { Line 348  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("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 353  sub xmlparse { Line 361  sub xmlparse {
   
  &clean_safespace($safeeval);   &clean_safespace($safeeval);
   
    if (@script_var_displays) {
        $finaloutput .= join('',@script_var_displays);
        undef(@script_var_displays);
    }
   
  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 369  sub latex_special_symbols { Line 382  sub latex_special_symbols {
  return $string;   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 546  sub callsub { Line 560  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 582  sub callsub { Line 595  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 603  sub callsub { Line 622  sub callsub {
 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;
Line 612  sub setup_globals { Line 629  sub setup_globals {
   &init_counter();    &init_counter();
   @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 673  sub init_safespace { Line 691  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 776  sub init_safespace { Line 802  sub init_safespace {
   $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::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 817  sub delete_package_recurse { Line 846  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 889  sub end_tag { Line 918  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 &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; }      if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
     return $id;      return $id;
Line 979  sub get_all_text_unbalanced { Line 1007  sub get_all_text_unbalanced {
     return $result      return $result
 }  }
   
   =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)
   
   =cut
   
 sub increment_counter {  sub increment_counter {
     my ($increment) = @_;      my ($increment) = @_;
     if (defined($increment) && $increment gt 0) {      if (defined($increment) && $increment gt 0) {
Line 989  sub increment_counter { Line 1035  sub increment_counter {
     $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 1018  sub store_counter { Line 1072  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'};
     }      }
   
Line 1029  sub store_counter { Line 1083  sub store_counter {
     }      }
     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'};
     }      }
 }  }
Line 1153  sub newparser { Line 1207  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 1187  sub writeallows { Line 1245  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 1206  sub do_registered_ssi { Line 1264  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 1286  SIMPLECONTENT Line 1350  SIMPLECONTENT
   
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents,$filetype)=@_;        my ($filecontents,$filetype)=@_;
       $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='';
         my $add_to_onload;
       if ($filetype eq 'html') {        if ($filetype eq 'html') {
   my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();    my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
   $initialize=&Apache::lonhtmlcommon::htmlareaheaders().    $initialize=&Apache::lonhtmlcommon::spellheader();
       &Apache::lonhtmlcommon::spellheader();  
   if (!&Apache::lonhtmlcommon::htmlareablocked() &&    if (!&Apache::lonhtmlcommon::htmlareablocked() &&
       &Apache::lonhtmlcommon::htmlareabrowser()) {        &Apache::lonhtmlcommon::htmlareabrowser()) {
       $initialize.=(<<FULLPAGE);        $initialize.=(<<FULLPAGE);
Line 1319  $addbuttons Line 1383  $addbuttons
 </script>  </script>
 FULLPAGE  FULLPAGE
   }    }
           $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;    $add_to_onload = 'initDocument();';
   $xml_help=&Apache::loncommon::helpLatexCheatsheet();    $xml_help=&Apache::loncommon::helpLatexCheatsheet();
       }        }
       my $cleanbut = '';        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 $buttons=(<<BUTTONS);
 $cleanbut  $cleanbut
   <input type="submit" name="discardview" accesskey="d"  value="$lt{'dv'}" />
   <input type="submit" name="Undo" accesskey="u"  value="$lt{'un'}" /><hr>
 <input type="submit" name="savethisfile" accesskey="s"  value="$lt{'st'}" />  <input type="submit" name="savethisfile" accesskey="s"  value="$lt{'st'}" />
 <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />  <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
 BUTTONS  BUTTONS
       $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');        $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
       $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');  
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
 $initialize  $initialize
 <hr />  <hr />
Line 1350  $buttons<br /> Line 1417  $buttons<br />
 $titledisplay  $titledisplay
 </body>  </body>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;        return ($editfooter,$add_to_onload);;
       $result=~s/(\<\/body\>)/$editfooter/is;  
       return $result;  
 }  }
   
 sub get_target {  sub get_target {
Line 1410  sub handler { Line 1475  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;
Line 1425  sub handler { Line 1486  sub handler {
     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('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);
 $start_page  $start_page
Line 1451  ENDNOTFOUND Line 1512  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,      $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
  '',%mystyle);   '',%mystyle);
     undef($Apache::lonhomework::parsing_a_task);      undef($Apache::lonhomework::parsing_a_task);
Line 1465  ENDNOTFOUND Line 1526  ENDNOTFOUND
 # 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 ($edit_info, $add_to_onload)=
    &inserteditinfo($filecontents,$filetype);
   
     my $displayfile=$request->uri;      my $displayfile=$request->uri;
     $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
     my %options = ();      my %options = 
    ('add_entries' =>
       {'onload'   => $add_to_onload, });
     if ($env{'environment.remote'} ne 'off') {      if ($env{'environment.remote'} ne 'off') {
  $options{'bgcolor'}   = '#FFFFFF';   $options{'bgcolor'}   = '#FFFFFF';
    $options{'only_body'} = 1;
     }      }
     my $start_page = &Apache::loncommon::start_page(undef,undef,      my $start_page = &Apache::loncommon::start_page(undef,undef,
     \%options);      \%options);
     $result=$start_page.      $result=$start_page.
  &Apache::lonxml::message_location().'<h3>'.   &Apache::lonxml::message_location().'<h3>'.
  $displayfile.   $displayfile.
  '</h3>'.&Apache::loncommon::end_page();   '</h3>'.
     $result=&inserteditinfo($result,$filecontents,$filetype);   $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 1545  sub error { Line 1613  sub error {
     #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 $msg = join('<br />',@_);   my $host=$Apache::lonnet::perlvar{'lonHostID'};
    my $msg = join('<br />',(@_,"The error occurred on host <tt>$host</tt>"));
  #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(/:/, $_);
Line 1564  sub error { Line 1634  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]",$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);
Line 1628  sub get_param { Line 1701  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 1654  sub get_param_var { Line 1727  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 1673  sub get_param_var { Line 1746  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.409  
changed lines
  Added in v.1.450

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