apps/irssi/src/perl/common/Irssi.pm

   1 #
   2 # Perl interface to irssi functions.
   3 #
   4
   5 package Irssi;
   6
   7 use strict;
   8 use Carp;
   9 use vars qw($VERSION $in_irssi @ISA @EXPORT @EXPORT_OK);
  10
  11 # TIEHANDLE methods
  12
  13 sub TIEHANDLE {
  14   my ($class, $level, $object, $target) = @_;
  15   return bless [ $level, $object, $target ], $class;
  16 }
  17
  18 sub WRITE {
  19   croak "Cannot syswrite() to an Irssi handle"
  20 }
  21
  22 sub PRINT {
  23   my ($self, @list) = @_;
  24   if (defined $self->[1]) {
  25     if (defined $self->[2]) {
  26       $self->[1]->print($self->[2], join('', @list), $self->[0]);
  27     } else {
  28       $self->[1]->print(join('', @list), $self->[0]);
  29     }
  30   } else {
  31     Irssi::print(join('', @list), $self->[0]);
  32   }
  33 }
  34
  35 sub PRINTF {
  36   my ($self, $format, @list) = @_;
  37   if (defined $self->[1]) {
  38     if (defined $self->[2]) {
  39       $self->[1]->print($self->[2], sprintf($format, @list), $self->[0]);
  40     } else {
  41       $self->[1]->print(sprintf($format, @list), $self->[0]);
  42     }
  43   } else {
  44     Irssi::print(sprintf($format, @list), $self->[0]);
  45   }
  46 }
  47
  48 sub READ {
  49   croak "Cannot [sys]read() from an Irssi handle"
  50 }
  51
  52 sub READLINE {
  53   croak "Cannot readline() from an Irssi handle"
  54 }
  55
  56 sub GETC {
  57   croak "Cannot getc() from an Irssi handle"
  58 }
  59
  60 sub CLOSE {}
  61 sub UNTIE {}
  62 sub DESTROY {}
  63
  64 # End of TIEHANDLE methods
  65
  66 # Handle creators
  67
  68 sub create_window_handle {
  69   my ($object, $level) = @_;
  70   $object = eval 'active_win'          unless defined $object;
  71   $level  = eval 'MSGLEVEL_CLIENTCRAP' unless defined $level;
  72   croak 'Usage: create_window_handle([$window[, $level]])'
  73     if ref $object !~ /::Window$/i;
  74   no strict 'refs';
  75   my $symref = 'Irssi::Handles::' . $object . '/' . $level;
  76   my $fh = \*{$symref};
  77   tie *{$symref}, __PACKAGE__, $level, $object;
  78   return $fh;
  79 }
  80
  81 sub create_server_handle {
  82   my ($object, $target, $level) = @_;
  83   croak 'Usage: create_server_handle($server, $target[, $level])'
  84     if not defined $object
  85     or not defined $target
  86     or ref $object !~ /::Server$/i;
  87   $level = eval 'MSGLEVEL_CLIENTCRAP' unless defined $level;
  88   no strict 'refs';
  89   my $symref = 'Irssi::Handles::' . $object . '/' . $target . '/' . $level;
  90   my $fh = \*{$symref};
  91   tie *{$symref}, __PACKAGE__, $level, $object, $target;
  92   return $fh;
  93 }
  94
  95 # Object interface for create_server_handle
  96
  97 sub Irssi::Server::create_handle {
  98   goto &Irssi::create_server_handle;
  99 }
 100
 101 # Normal Irssi.pm stuff
 102
 103 sub VERSION {
 104   my $version = $_[1];
 105   die "This script requires irssi version $version or later"
 106     if ($version > version());
 107 }
 108
 109 sub EXPORT_ALL () {
 110   my %exports = map { $_ => undef } @EXPORT, @EXPORT_OK;
 111   no strict 'refs';
 112   for (keys %Irssi::) {
 113     if (/^MSGLEVEL_/) {
 114       (my $short = $_) =~ s///;
 115       next if exists $exports{"*$short"};
 116       tie *{ $short }, __PACKAGE__, &$_();
 117       push @EXPORT, "*$short";
 118     } else {
 119       next if exists $exports{$_};
 120       push @EXPORT_OK, $_ if /[a-z]/ && defined *{$_}{CODE};
 121     }
 122   }
 123
 124   tie *DEFAULT, __PACKAGE__, MSGLEVEL_CLIENTCRAP();
 125   select DEFAULT;
 126 }
 127
 128 sub in_irssi {
 129   return $in_irssi;
 130 }
 131
 132 $VERSION = "0.9";
 133
 134 require Exporter;
 135 require DynaLoader;
 136
 137 @ISA = qw(Exporter DynaLoader);
 138 @EXPORT = qw(INPUT_READ INPUT_WRITE
 139         MSGLEVEL_CRAP MSGLEVEL_MSGS MSGLEVEL_PUBLIC MSGLEVEL_NOTICES
 140         MSGLEVEL_SNOTES MSGLEVEL_CTCPS MSGLEVEL_ACTIONS MSGLEVEL_JOINS
 141         MSGLEVEL_PARTS MSGLEVEL_QUITS MSGLEVEL_KICKS MSGLEVEL_MODES
 142         MSGLEVEL_TOPICS MSGLEVEL_WALLOPS MSGLEVEL_INVITES MSGLEVEL_NICKS
 143         MSGLEVEL_DCC MSGLEVEL_DCCMSGS MSGLEVEL_CLIENTNOTICE MSGLEVEL_CLIENTCRAP
 144         MSGLEVEL_CLIENTERROR MSGLEVEL_HILIGHT MSGLEVEL_ALL MSGLEVEL_NOHILIGHT
 145         MSGLEVEL_NO_ACT MSGLEVEL_NEVER MSGLEVEL_LASTLOG
 146 );
 147
 148 my $static = 0;
 149
 150 eval {
 151   $static = Irssi::Core::is_static();
 152 };
 153 $in_irssi = $@ ? 0 : 1;
 154
 155 if (!in_irssi()) {
 156   print "Warning: This script should be run inside irssi\n";
 157 } else {
 158   bootstrap Irssi $VERSION if (!$static);
 159
 160   @Irssi::Channel::ISA = qw(Irssi::Windowitem);
 161   @Irssi::Query::ISA = qw(Irssi::Windowitem);
 162
 163   Irssi::init();
 164
 165   Irssi::EXPORT_ALL();
 166 }
 167
 168 1;