irssi/src/perl/common/Irssi.pm

#
# Perl interface to irssi functions.
#

package Irssi;

use strict;
use Carp;
use vars qw($VERSION $in_irssi @ISA @EXPORT @EXPORT_OK);

# TIEHANDLE methods

sub TIEHANDLE {
  my ($class, $level, $object, $target) = @_;
  return bless [ $level, $object, $target ], $class;
}

sub WRITE {
  croak "Cannot syswrite() to an Irssi handle"
}

sub PRINT {
  my ($self, @list) = @_;
  if (defined $self->[1]) {
    if (defined $self->[2]) {
      $self->[1]->print($self->[2], join('', @list), $self->[0]);
    } else {
      $self->[1]->print(join('', @list), $self->[0]);
    }
  } else {
    Irssi::print(join('', @list), $self->[0]);
  }
}

sub PRINTF {
  my ($self, $format, @list) = @_;
  if (defined $self->[1]) {
    if (defined $self->[2]) {
      $self->[1]->print($self->[2], sprintf($format, @list), $self->[0]);
    } else {
      $self->[1]->print(sprintf($format, @list), $self->[0]);
    }
  } else {
    Irssi::print(sprintf($format, @list), $self->[0]);
  }
}

sub READ {
  croak "Cannot [sys]read() from an Irssi handle"
}

sub READLINE {
  croak "Cannot readline() from an Irssi handle"
}

sub GETC {
  croak "Cannot getc() from an Irssi handle"
}

sub CLOSE {}
sub UNTIE {}
sub DESTROY {}

# End of TIEHANDLE methods

# Handle creators

sub create_window_handle {
  my ($object, $level) = @_;
  $object = eval 'active_win'          unless defined $object;
  $level  = eval 'MSGLEVEL_CLIENTCRAP' unless defined $level;
  croak 'Usage: create_window_handle([$window[, $level]])'
    if ref $object !~ /::Window$/i;
  no strict 'refs';
  my $symref = 'Irssi::Handles::' . $object . '/' . $level;
  my $fh = \*{$symref};
  tie *{$symref}, __PACKAGE__, $level, $object;
  return $fh;
}

sub create_server_handle {
  my ($object, $target, $level) = @_;
  croak 'Usage: create_server_handle($server, $target[, $level])'
    if not defined $object
    or not defined $target
    or ref $object !~ /::Server$/i;
  $level = eval 'MSGLEVEL_CLIENTCRAP' unless defined $level;
  no strict 'refs';
  my $symref = 'Irssi::Handles::' . $object . '/' . $target . '/' . $level;
  my $fh = \*{$symref};
  tie *{$symref}, __PACKAGE__, $level, $object, $target;
  return $fh;
}

# Object interface for create_server_handle

sub Irssi::Server::create_handle {
  goto &Irssi::create_server_handle;
}

# Normal Irssi.pm stuff

sub VERSION {
  my $version = $_[1];
  die "This script requires irssi version $version or later"
    if ($version > version());
}

sub EXPORT_ALL () {
  my %exports = map { $_ => undef } @EXPORT, @EXPORT_OK;
  no strict 'refs';
  for (keys %Irssi::) {
    if (/^MSGLEVEL_/) {
      (my $short = $_) =~ s///;
      next if exists $exports{"*$short"};
      tie *{ $short }, __PACKAGE__, &$_();
      push @EXPORT, "*$short";
    } else {
      next if exists $exports{$_};
      push @EXPORT_OK, $_ if /[a-z]/ && defined *{$_}{CODE};
    }
  }

  tie *DEFAULT, __PACKAGE__, MSGLEVEL_CLIENTCRAP();
  select DEFAULT;
}

sub in_irssi {
  return $in_irssi;
}

$VERSION = "0.9";

require Exporter;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(INPUT_READ INPUT_WRITE
	MSGLEVEL_CRAP MSGLEVEL_MSGS MSGLEVEL_PUBLIC MSGLEVEL_NOTICES
	MSGLEVEL_SNOTES MSGLEVEL_CTCPS MSGLEVEL_ACTIONS MSGLEVEL_JOINS
	MSGLEVEL_PARTS MSGLEVEL_QUITS MSGLEVEL_KICKS MSGLEVEL_MODES
	MSGLEVEL_TOPICS MSGLEVEL_WALLOPS MSGLEVEL_INVITES MSGLEVEL_NICKS
	MSGLEVEL_DCC MSGLEVEL_DCCMSGS MSGLEVEL_CLIENTNOTICE MSGLEVEL_CLIENTCRAP
	MSGLEVEL_CLIENTERROR MSGLEVEL_HILIGHT MSGLEVEL_ALL MSGLEVEL_NOHILIGHT
	MSGLEVEL_NO_ACT MSGLEVEL_NEVER MSGLEVEL_LASTLOG
);

my $static = 0;

eval {
  $static = Irssi::Core::is_static();
};
$in_irssi = $@ ? 0 : 1;

if (!in_irssi()) {
  print "Warning: This script should be run inside irssi\n";
} else {
  bootstrap Irssi $VERSION if (!$static);

  @Irssi::Channel::ISA = qw(Irssi::Windowitem);
  @Irssi::Query::ISA = qw(Irssi::Windowitem);

  Irssi::init();

  Irssi::EXPORT_ALL();
}

1;