apps/irssi/src/perl/irssi-core.pl

   1 # NOTE: this is printed through printf()-like function,
   2 # so no extra percent characters.
   3
   4 # %%d : must be first - 1 if perl libraries are to be linked
   5 #       statically with irssi binary, 0 if not
   6 # %%s : must be second - use Irssi; use Irssi::Irc; etc..
   7 package Irssi::Core;
   8
   9 use Symbol;
  10
  11 $SIG{__WARN__} = sub {
  12   my @msg = @_;
  13   s/%%/%%%%/g for @msg;
  14   print @msg;
  15 };
  16
  17 sub is_static {
  18   return %d;
  19 }
  20
  21 sub destroy {
  22   eval { $_[0]->UNLOAD() if $_[0]->can('UNLOAD'); };
  23   Symbol::delete_package($_[0]);
  24 }
  25
  26 sub eval_data {
  27   my $ret = eval do {
  28     my ($data, $id) = @_;
  29     destroy("Irssi::Script::$id");
  30     my $code = qq{package Irssi::Script::$id; %s $data};
  31     $code
  32   };
  33   $@ and die $@;
  34   $ret
  35 }
  36
  37 sub eval_file {
  38   my ($filename, $id) = @_;
  39
  40   open my $fh, '<', $filename or die "Can't open $filename: $!";
  41   my $data = do {local $/; <$fh>};
  42   close $fh;
  43
  44   $filename =~ s/(["\\])/\\$1/g;
  45   $filename =~ s/\n/\\n/g;
  46
  47   $data = qq{\n#line 1 "$filename"\n$data};
  48
  49   eval_data($data, $id);
  50 }