Diff for /loncom/xml/lonxml.pm between versions 1.415 and 1.420

version 1.415, 2006/07/11 09:44:04 version 1.420, 2006/09/29 20:36:45
Line 772  sub init_safespace { Line 772  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,'&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 1149  sub newparser { Line 1152  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 1541  sub error { Line 1548  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 occured on host <tt>$host</tt>"));   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
Line 1624  sub get_param { Line 1631  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 1650  sub get_param_var { Line 1657  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*$/) {

Removed from v.1.415  
changed lines
  Added in v.1.420


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