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

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