RE: Need advanced help with tracking down warnings in eval'd functions

From: Kirk Bauer (kirk_at_kaybee.org)
Date: 12/09/04


Date: Thu, 9 Dec 2004 09:50:13 -0700 (MST)
To: "Bakken, Luke" <Luke.Bakken@getronics.com>

On Thu, 9 Dec 2004, Bakken, Luke wrote:

> Or modules for that matter. When I first read the eval trickery my first
> thought was "WHY???".

Well, I have a set of script files. Each file is split into an init
section and several different scripts. The init section is eval'd right
away and each script section is eval'd when needed.

The reason I went this way was to make these script files as simple as
possible and, more importantly, so that I can reload them as many times
as I want without having to exit the program.

When a warning happens in the script file below, it works fine because I
know which file, script, and section is being executed. So
handle_warn() can properly display the error.

But if another script file defines a function in its INIT section, and
this script calls that function, I still think the warning came from
this file. The only way I see around this is to see that this file was
(eval 12) and the other file was (eval 10) so when I see (eval 10) in
the warning I can know that the line number refers to the other file.

Here is an example script file:

--------------------------------------------------------------------
# SECTION(INIT)
script_name 'Bookmarks';
script_version '0.1';
script_desc 'Scripts to add and remove bookmarks';

###############################################################################
# USER SCRIPT(add_bookmark): Adds a new bookmark
# SECTION(INFO)

argument 'sector', required => 1, prompt => 'Bookmark which sector?',
   type => 'integer', min => 1,
   max => sub {return $game_data{'game_settings'}{'max_sectors'}},
   default => sub {return $game_data{'user'}{'curr_sector'}};

argument 'name', required => 1, prompt => 'Name the bookmark', type => 'string';

# SECTION(CODE)

if ($name =~ /^\d+$/) {
   print_text($RED . "ERROR: Bookmark name must not contain only numbers!\n" . $WHITE);
} else {
   if (exists $game_data{'bookmarks'}{$name}) {
      print_text($RED . "ERROR: Bookmark '$name' already exists!\n" . $WHITE);
   } else {
      $game_data{'bookmarks'}{$name} = $sector;
      print_text($GREEN . "Bookmark $name => $sector added.\n" . $WHITE);
   }
}
###############################################################################
# USER SCRIPT(remove_bookmark): Removes a bookmark
# SECTION(INFO)

argument 'name', required => 1, prompt => 'Remove which bookmark', type => 'string', complete => sub {
      my @ret;
      if (exists $game_data{'bookmarks'}) {
         @ret = (keys %{$game_data{'bookmarks'}});
      }
      return \@ret;
   };

# SECTION(CODE)

if (exists $game_data{'bookmarks'}{$name}) {
   delete $game_data{'bookmarks'}{$name};
   print_text($GREEN . "Bookmark $name removed.\n" . $WHITE);
} else {
   print_text($RED . "ERROR: Bookmark '
--------------------------------------------------------------------

Here is some of the code that parses this:

my %scripts;
my $curr_script_section;
my $curr_script_file;
my $curr_script;

sub handle_warn {
   my $warning = $_[0];
   my $file = $curr_script_file;
   if ($curr_script) {
      $file .= '(' . $curr_script . ')'
   }
   if ($curr_script_section) {
      $file .= '[' . $curr_script_section . ']'
   }
   my $line = 0;
   if ($warning =~ s/\(eval \d+\) line (\d+)\.$/$file/) {
      $line = $1;
      $line -= 2;
      $warning .= "line $line.";
   }
   print_text($RED . "WARNING: $WHITE");
   print_text_wrap($warning . "\n");
}
$SIG{__WARN__} = \&handle_warn;

sub remove_script_file {
   my ($file) = @_;
   delete $scripts{$file};
}

sub eval_script_code {
   my ($script_file, $script, $section, $code) = @_;
   local $SIG{__WARN__} = sub {
       return if $_[0] =~ /redefined at/;
       &handle_warn(@_);
   };
   $curr_script_section = $section;
   $curr_script_file = $script_file;
   $curr_script = $script;
   debug("Executing $script($section) from file $script_file");
   eval $code;
   $curr_script_file = 'main';
   $curr_script = '';
   $curr_script_section = '';
   if ($@) {
      print_text("Error(s) in script file '$script_file' $script($section) (aborting and unloading)\n", $@);
      remove_script_file($script_file);
      return 0;
   }
   return 1;
}

sub process_script_file {
   my ($file) = @_;
   if ($scripts{$file}{'sections'}{'INIT'}) {
      eval_script_code $file, '', 'INIT', $scripts{$file}{'sections'}{'INIT'} or return 0;
   }
   foreach my $script (keys %{$scripts{$file}{'scripts'}}) {
      if ($scripts{$file}{'scripts'}{$script}{'sections'}{'INFO'}) {
         eval_script_code $file, $script, 'INFO', $scripts{$file}{'scripts'}{$script}{'sections'}{'INFO'} or return 0;
      }
      if ($scripts{$file}{'scripts'}{$script}{'sections'}{'FUNCTIONS'}) {
         eval_script_code $file, $script, 'FUNCTIONS', $scripts{$file}{'scripts'}{$script}{'sections'}{'FUNCTIONS'} or return 0;
      }
   }
   return 1;
}

sub read_script_file {
   my ($file) = @_;
   return unless $file;
   remove_script_file($file);
   if (is_script_file_disabled($file)) {
      print_text(" Skipping $file (disabled)\n");
      return;
   }
   if (open(CODE, "$global_data{'settings'}{'main'}{'script_dir'}/$file")) {
      print_text(" Reading $file...");
      my $section = '';
      my $script = '';
      while (my $line = <CODE>) {
         if ($line =~ /^\s*#\s*SECTION\(([^)]+)\)/) {
            $section = $1;
         } elsif ($line =~ /^\s*#\s*SCRIPT\(([^)]+)\): (.+)/) {
            $script = $1;
            $scripts{$file}{'scripts'}{$script}{'name'} = $script;
            $scripts{$file}{'scripts'}{$script}{'desc'} = $2;
         } elsif ($line =~ /^\s*#\s*USER\s+SCRIPT\(([^)]+)\): (.+)/) {
            $script = $1;
            $scripts{$file}{'scripts'}{$script}{'name'} = $script;
            $scripts{$file}{'scripts'}{$script}{'desc'} = $2;
            $scripts{$file}{'scripts'}{$script}{'user'} = 1;
         } else {
            $line =~ s/__SCRIPT_FILE__/'$file'/g;
            if ($script) {
               $scripts{$file}{'scripts'}{$script}{'sections'}{$section} .= $line;
            } else {
               $scripts{$file}{'sections'}{$section} .= $line;
            }
         }
      }
      close CODE;
      if (process_script_file($file)) {
         print_text("$GREEN OK$WHITE.\n");
         $scripts{$file}{'mod_time'} = (stat("$global_data{'settings'}{'main'}{'script_dir'}/$file"))[9];
      }
   }
}



Relevant Pages

  • using WScript.CreateObject("Wscript.Shell
    ... Sub Test() ... Dim objShell As Object ... FTP02.BAT points to a script file that will "get" a file from an IBM ... an external source before the spreadsheet data is shown. ...
    (microsoft.public.excel.programming)
  • Re: Global subroutine - does still not work!
    ... As you can see I have the Sub here in the same source file but the call to ... subroutine refers to the script file at "c:\temp\scripts.txt" ... > "John C" wrote in message ...
    (microsoft.public.frontpage.programming)
  • Re: Global subroutine - doesnt work
    ... I have the following in my script file (name "scripts.vb" in same ... Sub PrintDetails ... >> How can I create a Global subroutine. ... >> Sub PrintDetails(CompName, Discount) ...
    (microsoft.public.frontpage.programming)