Diff for /loncom/xml/lonxml.pm between versions 1.446 and 1.467

version 1.446, 2007/05/17 21:00:59 version 1.467, 2007/10/24 10:06:22
Line 92  use Apache::loncacc(); Line 92  use Apache::loncacc();
 use Apache::lonmaxima();  use Apache::lonmaxima();
 use Apache::lonlocal;  use Apache::lonlocal;
   
 #==================================================   Main subroutine: xmlparse    #====================================   Main subroutine: xmlparse  
   
 #debugging control, to turn on debugging modify the correct handler  #debugging control, to turn on debugging modify the correct handler
   
 $Apache::lonxml::debug=0;  $Apache::lonxml::debug=0;
   
 # keeps count of the number of warnings and errors generated in a parse  # keeps count of the number of warnings and errors generated in a parse
Line 125  $evaluate = 1; Line 127  $evaluate = 1;
 # 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 132  $Apache::lonxml::request=''; Line 137  $Apache::lonxml::request='';
 $Apache::lonxml::counter=1;  $Apache::lonxml::counter=1;
 $Apache::lonxml::counter_changed=0;  $Apache::lonxml::counter_changed=0;
   
   # Part counter hash.   In analysis mode, the
   # problems can use this to record which parts increment the counter
   # by how much.  The counter subs will maintain this hash via
   # their optional part parameters.  Note that the assumption is that
   # analysis is done in one request and therefore it is not necessary to
   # save this information request-to-request.
   
   
   %Apache::lonxml::counters_per_part = ();
   
 #internal check on whether to look at style defs  #internal check on whether to look at style defs
 $Apache::lonxml::usestyle=1;  $Apache::lonxml::usestyle=1;
   
Line 316  sub xmlparse { Line 331  sub xmlparse {
      }       }
  }   }
      }       }
  } elsif ($env{'construct.style'} && ($env{'request.state'} eq 'construct')) {   } elsif ($env{'construct.style'}
     && ($env{'request.state'} eq 'construct')) {
      my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});       my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});
      my $styletext=&Apache::lonnet::getfile($location);       my $styletext=&Apache::lonnet::getfile($location);
        if ($styletext ne '-1') {       if ($styletext ne '-1') {
           %style_for_target = (%style_for_target,   %style_for_target = (%style_for_target,
                           &Apache::style::styleparser($target,$styletext));        &Apache::style::styleparser($target,$styletext));
       }       }
  }   }
 #&printalltags();  #&printalltags();
  my @pars = ();   my @pars = ();
Line 357  sub xmlparse { Line 373  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 599  sub callsub { Line 620  sub callsub {
       }        }
   }    }
   if ($token->[0] eq 'S') {    if ($token->[0] eq 'S') {
     $currentstring.=&Apache::edit::handle_insert();        $currentstring.=&Apache::edit::handle_insert();
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
             $currentstring.=&Apache::edit::handle_insertafter($token->[1]);        $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
   }    }
       }        }
     }      }
Line 610  sub callsub { Line 631  sub callsub {
   return $currentstring;    return $currentstring;
 }  }
   
   {
       my %state;
   
       sub init_state {
    undef(%state);
       }
       
       sub set_state {
    my ($key,$value) = @_;
    $state{$key} = $value;
    return $value;
       }
       sub get_state {
    my ($key) = @_;
    return $state{$key};
       }
   }
   
 sub setup_globals {  sub setup_globals {
   my ($request,$target)=@_;    my ($request,$target)=@_;
   $Apache::lonxml::request=$request;    $Apache::lonxml::request=$request;
Line 618  sub setup_globals { Line 657  sub setup_globals {
   $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();
   @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 790  sub init_safespace { Line 832  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::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
Line 898  sub endredirection { Line 941  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 958  sub decreasedepth { Line 1004  sub decreasedepth {
 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 995  sub get_all_text_unbalanced { Line 1041  sub get_all_text_unbalanced {
  }   }
     }      }
     return $result      return $result
   
 }  }
   
   #########################################################################
   #                                                                       #
   #           bubble line counter management                              #
   #                                                                       #
   #########################################################################
   
   =pod
   
   For bubble grading mode and exam bubble printing mode, the tracking of
   the current 'bubble line number' is stored in the %env element
   'form.counter', and is modifed and handled by the following routines.
   
   The value of it is stored in $Apache:lonxml::counter when live and
   stored back to env after done.
   
   =item &increment_counter($increment);
   
   Increments the internal counter environment variable a specified amount
   
   Optional Arguments:
     $increment - amount to increment by (defaults to 1)
                  Also 1 if the value is negative or zero.
     $part_response - A concatenation of the part and response id
                      identifying exactly what is being 'answered'.
   
   
   =cut
   
 sub increment_counter {  sub increment_counter {
     my ($increment) = @_;      my ($increment, $part_response) = @_;
     if (defined($increment) && $increment gt 0) {      if (!defined($increment) || $increment le 0) {
  $Apache::lonxml::counter+=$increment;   $increment = 1;
     } else {      }
  $Apache::lonxml::counter++;      $Apache::lonxml::counter += $increment;
   
       # If the caller supplied the response_id parameter, 
       # Maintain its counter.. creating if necessary.
   
       if(defined($part_response)) {
    if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
       $Apache::lonxml::counters_per_part{$part_response} = 0;
    }
    $Apache::lonxml::counters_per_part{$part_response} += $increment;
    my $new_value = $Apache::lonxml::counters_per_part{$part_response};
     }      }
   
     $Apache::lonxml::counter_changed=1;      $Apache::lonxml::counter_changed=1;
 }  }
   
   =pod
   
   =item &init_counter($increment);
   
   Initialize the internal counter environment variable
   
   =cut
   
 sub init_counter {  sub init_counter {
     if ($env{'request.state'} eq 'construct') {      if ($env{'request.state'} eq 'construct') {
  $Apache::lonxml::counter=1;   $Apache::lonxml::counter=1;
Line 1052  sub store_counter { Line 1146  sub store_counter {
     }      }
 }  }
   
   =pod
   
   =item  bubble_lines_for_part(response_id)
   
   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(response_id, 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 1228  sub do_registered_ssi { Line 1390  sub do_registered_ssi {
  &Apache::lonnet::ssi($url,%form);   &Apache::lonnet::ssi($url,%form);
     }      }
 }  }
   
   sub add_script_result {
       my ($display) = @_;
       push(@script_var_displays, $display);
   }
   
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
Line 1308  SIMPLECONTENT Line 1476  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='';
       if ($filetype eq 'html') {        my $textarea_id = 'filecont';
   my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();        my ($add_to_onload, $add_to_onresize);
   $initialize=&Apache::lonhtmlcommon::spellheader();        $initialize=&Apache::lonhtmlcommon::spellheader();
   if (!&Apache::lonhtmlcommon::htmlareablocked() &&        if ($filetype eq 'html' 
       &Apache::lonhtmlcommon::htmlareabrowser()) {    && (!&Apache::lonhtmlcommon::htmlareablocked() &&
       $initialize.=(<<FULLPAGE);        &Apache::lonhtmlcommon::htmlareabrowser())) {
     $textarea_id .= '___Frame';
     my $lang = &Apache::lonhtmlcommon::htmlarea_lang();
     $initialize.=(<<FULLPAGE);
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  lonca
   
     HTMLArea.loadPlugin("FullPage");  
   
     function initDocument() {      function initDocument() {
  var editor=new HTMLArea("filecont",config);          var oFCKeditor = new FCKeditor('filecont');
  editor.registerPlugin(FullPage);   oFCKeditor.Config['CustomConfigurationsPath'] = '/fckeditor/loncapaconfig.js'  ;
  editor.generate();   oFCKeditor.Config['FullPage'] = true
    oFCKeditor.Config['AutoDetectLanguage'] = false;
           oFCKeditor.Config['DefaultLanguage'] = "$lang";
    oFCKeditor.ReplaceTextarea();
       }
       function check_if_dirty(editor) {
    if (editor.IsDirty()) {
       unClean();
    }
       }
       function FCKeditor_OnComplete(editor) {
    editor.Events.AttachEvent("OnSelectionChange",check_if_dirty);
    resize_textarea('$textarea_id','LC_aftertextarea');
     }      }
 </script>  </script>
 FULLPAGE  FULLPAGE
           } else {        } else {
       $initialize.=(<<FULLPAGE);    $initialize.=(<<FULLPAGE);
 <script type="text/javascript">  <script type="text/javascript">
 $addbuttons  
     function initDocument() {      function initDocument() {
    resize_textarea('$textarea_id','LC_aftertextarea');
     }      }
 </script>  </script>
 FULLPAGE  FULLPAGE
   }        }
           $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;  
         $add_to_onload = 'initDocument();';
         $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";
   
         if ($filetype eq 'html') {
   $xml_help=&Apache::loncommon::helpLatexCheatsheet();    $xml_help=&Apache::loncommon::helpLatexCheatsheet();
       }        }
   
       my $cleanbut = '';        my $cleanbut = '';
   
       my $titledisplay=&display_title();        my $titledisplay=&display_title();
Line 1354  FULLPAGE Line 1539  FULLPAGE
       my $buttons=(<<BUTTONS);        my $buttons=(<<BUTTONS);
 $cleanbut  $cleanbut
 <input type="submit" name="discardview" accesskey="d"  value="$lt{'dv'}" />  <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="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');
         my $textarea_events = &Apache::edit::element_change_detection();
         my $form_events     = &Apache::edit::form_change_detection();
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
 $initialize  $initialize
 <hr />  <hr />
 <a name="editsection" />  <a name="editsection" />
 <form method="post" name="xmledit">  <form $form_events method="post" name="xmledit">
 $xml_help  $xml_help
 <input type="hidden" name="editmode" value="$lt{'ed'}" />  <input type="hidden" name="editmode" value="$lt{'ed'}" />
 $buttons<br />  $buttons<br />
 <textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>  <textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
   <div id="LC_aftertextarea">
 <br />$buttons  <br />$buttons
 <br />  <br />
 </form>  
 $titledisplay  $titledisplay
   </div>
   </form>
 </body>  </body>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;        return ($editfooter,$add_to_onload,$add_to_onresize);;
       $result=~s/(\<\/body\>)/$editfooter/is;  
       return $result;  
 }  }
   
 sub get_target {  sub get_target {
Line 1472  ENDNOTFOUND Line 1659  ENDNOTFOUND
     ['editmode']);      ['editmode']);
  }   }
  if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) {   if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) {
       &Apache::structuretags::reset_problem_globals();
     $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,      $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
  '',%mystyle);   '',%mystyle);
     undef($Apache::lonhomework::parsing_a_task);      # .html files may contain <problem> or <Task> need to clean
       # up if it did
       &Apache::structuretags::reset_problem_globals();
       &Apache::lonhomework::finished_parsing();
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     ['rawmode']);      ['rawmode']);
     if ($env{'form.rawmode'}) { $result = $filecontents; }      if ($env{'form.rawmode'}) { $result = $filecontents; }
       if ($filetype eq 'sty') {
    my $controls =
       ($env{'request.state'} eq 'construct') ? &Apache::londefdef::edit_controls()
                                              : '';
    my %options = ('bgcolor' => '#FFFFFF');
    $result = 
       &Apache::loncommon::start_page(undef,undef,\%options).
       $controls.
       $result.
       &Apache::loncommon::end_page();
       }
  }   }
     }      }
       
 #  #
 # Edit action? Insert editing commands  # Edit action? Insert editing commands
 #  #
     unless ($env{'request.state'} eq 'published') {      unless ($env{'request.state'} eq 'published') {
  if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))   if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
     {   {
       my ($edit_info, $add_to_onload, $add_to_onresize)=
    &inserteditinfo($filecontents,$filetype);
   
     my $displayfile=$request->uri;      my $displayfile=$request->uri;
     $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
     my %options = ();      my %options = 
    ('add_entries' =>
                      {'onresize' => $add_to_onresize,
       '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 $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>'.   &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 1552  sub show_error_warn_msg { Line 1765  sub show_error_warn_msg {
 }  }
   
 sub error {  sub error {
       my @errors = @_;
   
     $errorcount++;      $errorcount++;
   
       if (defined($Apache::inputtags::part)) {
    if ( @Apache::inputtags::response ) {
       push(@errors,
    &mt("This error occurred while processing response [_1] in part [_2]",
        $Apache::inputtags::response[-1],
        $Apache::inputtags::part));
    } else {
       push(@errors,
    &mt("This error occurred while processing part [_1]",
        $Apache::inputtags::part));
    }
       }
   
     if ( &show_error_warn_msg() ) {      if ( &show_error_warn_msg() ) {
  # If printing in construction space, put the error inside <pre></pre>   # If printing in construction space, put the error inside <pre></pre>
  push(@Apache::lonxml::error_messages,   push(@Apache::lonxml::error_messages,
      $Apache::lonxml::warnings_error_header.       $Apache::lonxml::warnings_error_header.
      "<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");       "<b>ERROR:</b>".join("<br />\n",@errors)."<br />\n");
  $Apache::lonxml::warnings_error_header='';   $Apache::lonxml::warnings_error_header='';
     } else {      } else {
  my $errormsg;   my $errormsg;
Line 1567  sub error { Line 1796  sub error {
     $errormsg=&mt("An error occured while processing this resource. The author has been notified.");      $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
  }   }
  my $host=$Apache::lonnet::perlvar{'lonHostID'};   my $host=$Apache::lonnet::perlvar{'lonHostID'};
  my $msg = join('<br />',(@_,"The error occurred on host <tt>$host</tt>"));   push(@errors, "The error occurred on host <tt>$host</tt>");
   
    my $msg = join('<br />', @errors);
   
  #notify author   #notify author
  &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);   &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
  #notify course   #notify course

Removed from v.1.446  
changed lines
  Added in v.1.467


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