From 0327b7d5dc067eb04f065ea165ceb7d5202c3316 Mon Sep 17 00:00:00 2001
From: Emanuele Giaquinta <exg@irssi.org>
Date: Tue, 9 Dec 2008 21:42:51 +0000
Subject: [PATCH] Clean up script loading in general. Don't leak local
 variables to eval'd code. Set filename/line number to get better error
 messages from perl. Use three-arg open and lexical filehandles to avoid
 surprises. Include error reason in message for unopenable scripts. Don't wrap
 script code in sub handler { } - this avoids spurious warnings and should at
 least allow __END__ to work properly. Patch by Lukas Mai.

git-svn-id: file:///var/www/svn.irssi.org/SVN/irssi/trunk@4961 dbcabf3a-b0e7-0310-adc4-f8d773084564
---
 src/perl/irssi-core.pl | 46 +++++++++++++++++++-----------------------
 1 file changed, 21 insertions(+), 25 deletions(-)

diff --git a/src/perl/irssi-core.pl b/src/perl/irssi-core.pl
index 50c2933f..8821e45b 100644
--- a/src/perl/irssi-core.pl
+++ b/src/perl/irssi-core.pl
@@ -8,6 +8,12 @@ package Irssi::Core;
 
 use Symbol;
 
+$SIG{__WARN__} = sub {
+  my @msg = @_;
+  s/%/%%/g for @msg;
+  print @msg;
+};
+
 sub is_static {
   return %d;
 }
@@ -18,37 +24,27 @@ sub destroy {
 }
 
 sub eval_data {
-  my ($data, $id) = @_;
-  destroy("Irssi::Script::$id");
-
-  $SIG{__WARN__} = sub {
-    Irssi::print("Warning in script $id:");
-    print $_[0];
+  my $ret = eval do {
+    my ($data, $id) = @_;
+    destroy("Irssi::Script::$id");
+    my $code = qq{package Irssi::Script::$id; %s $data};
+    $code
   };
-  my $package = "Irssi::Script::$id";
-  my $eval = qq{package $package; %s sub handler { $data; }};
-  {
-      # hide our variables within this block
-      my ($filename, $package, $data);
-      eval $eval;
-  }
-  die $@ if $@;
-
-  my $ret;
-  eval { $ret = $package->handler; };
-  die $@ if $@;
-  return $ret;
+  $@ and die $@;
+  $ret
 }
 
 sub eval_file {
   my ($filename, $id) = @_;
 
-  local *FH;
-  open FH, $filename or die "File not found: $filename";
-  local($/) = undef;
-  my $data = <FH>;
-  close FH;
-  local($/) = "\n";
+  open my $fh, '<', $filename or die "Can't open $filename: $!";
+  my $data = do {local $/; <$fh>};
+  close $fh;
+
+  $filename =~ s/(["\\])/\\$1/g;
+  $filename =~ s/\n/\\n/g;
+
+  $data = qq{\n#line 1 "$filename"\n$data};
 
   eval_data($data, $id);
 }