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   select CLIENTCRAP;
 124 }
 125
 126 sub in_irssi {
 127   return $in_irssi;
 128 }
 129
 130 $VERSION = "0.9";
 131
 132 require Exporter;
 133 require DynaLoader;
 134
 135 @ISA = qw(Exporter DynaLoader);
 136 @EXPORT = qw(INPUT_READ INPUT_WRITE
 137         MSGLEVEL_CRAP MSGLEVEL_MSGS MSGLEVEL_PUBLIC MSGLEVEL_NOTICES
 138         MSGLEVEL_SNOTES MSGLEVEL_CTCPS MSGLEVEL_ACTIONS MSGLEVEL_JOINS
 139         MSGLEVEL_PARTS MSGLEVEL_QUITS MSGLEVEL_KICKS MSGLEVEL_MODES
 140         MSGLEVEL_TOPICS MSGLEVEL_WALLOPS MSGLEVEL_INVITES MSGLEVEL_NICKS
 141         MSGLEVEL_DCC MSGLEVEL_DCCMSGS MSGLEVEL_CLIENTNOTICE MSGLEVEL_CLIENTCRAP
 142         MSGLEVEL_CLIENTERROR MSGLEVEL_HILIGHT MSGLEVEL_ALL MSGLEVEL_NOHILIGHT
 143         MSGLEVEL_NO_ACT MSGLEVEL_NEVER MSGLEVEL_LASTLOG
 144 );
 145
 146 my $static = 0;
 147
 148 eval {
 149   $static = Irssi::Core::is_static();
 150 };
 151 $in_irssi = $@ ? 0 : 1;
 152
 153 if (!in_irssi()) {
 154   print "Warning: This script should be run inside irssi\n";
 155 } else {
 156   bootstrap Irssi $VERSION if (!$static);
 157
 158   @Irssi::Channel::ISA = qw(Irssi::Windowitem);
 159   @Irssi::Query::ISA = qw(Irssi::Windowitem);
 160
 161   Irssi::init();
 162
 163   Irssi::EXPORT_ALL();
 164 }
 165
 166 1;