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

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

version 1.425, 2006/11/10 19:41:34 version 1.446, 2007/05/17 21:00:59
Line 42  package Apache::lonxml; Line 42  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 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 549  sub callsub { Line 551  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 585  sub callsub { Line 586  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 674  sub init_safespace { Line 681  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 780  sub init_safespace { Line 795  sub init_safespace {
   $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');    $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
   $safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');    $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;  #  use Data::Dumper;
   $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_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 893  sub end_tag { Line 908  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";
 }  }
   
Line 1195  sub writeallows { Line 1209  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 1332  FULLPAGE Line 1346  FULLPAGE
       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
Line 1416  sub handler { Line 1434  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 1457  ENDNOTFOUND Line 1471  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 1471  ENDNOTFOUND Line 1485  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 $displayfile=$request->uri;      my $displayfile=$request->uri;
     $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
     my %options = ();      my %options = ();
Line 1559  sub error { Line 1574  sub error {
  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 1571  sub error { Line 1587  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 1680  sub get_param_var { Line 1699  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"};  sub get_tag {
     if (defined($tagnum)) { last; }      my ($token)=@_;
   }      my $tagnum;
   if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }      my $tag=$token->[1];
   return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});      foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
    my $testtag = $namespace.'::'.$tag;
    $tagnum = $insertlist{"$testtag.num"};
    last if (defined($tagnum));
       }
       if (!defined($tagnum)) {
    $tagnum = $Apache::lonxml::insertlist{"$tag.num"};
       }
       return $insertlist{"$tagnum.tag"};
 }  }
   
 1;  1;
Removed from v.1.425  
changed lines
  Added in v.1.446

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