Added SILC Thread Queue API

[crypto.git] / apps / irssi / src / perl / common / Irssi.pm

diff --git a/apps/irssi/src/perl/common/Irssi.pm b/apps/irssi/src/perl/common/Irssi.pm
index ce35c52e9bfb3b214514cfb16f197f6d349e21c9..a9f93bf0da84220fe0c45df4be2b88874a110d76 100644 (file)
--- a/apps/irssi/src/perl/common/Irssi.pm
+++ b/apps/irssi/src/perl/common/Irssi.pm
@@ -5,7 +5,100 @@
 package Irssi;
 
 use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+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];
@@ -14,8 +107,26 @@ sub VERSION {
 }
 
 sub EXPORT_ALL () {
+  my %exports = map { $_ => undef } @EXPORT, @EXPORT_OK;
   no strict 'refs';
-  @EXPORT_OK = grep { /[a-z]/ && defined *{$_}{CODE} } keys %Irssi::;
+  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";
@@ -33,16 +144,25 @@ require DynaLoader;
        MSGLEVEL_CLIENTERROR MSGLEVEL_HILIGHT MSGLEVEL_ALL MSGLEVEL_NOHILIGHT
        MSGLEVEL_NO_ACT MSGLEVEL_NEVER MSGLEVEL_LASTLOG
 );
-@EXPORT_OK = qw();
 
-bootstrap Irssi $VERSION if (!Irssi::Core::is_static());
+my $static = 0;
 
-@Irssi::Channel::ISA = qw(Irssi::Windowitem);
-@Irssi::Query::ISA = qw(Irssi::Windowitem);
+eval {
+  $static = Irssi::Core::is_static();
+};
+$in_irssi = $@ ? 0 : 1;
 
-Irssi::init();
+if (!in_irssi()) {
+  print "Warning: This script should be run inside irssi\n";
+} else {
+  bootstrap Irssi $VERSION if (!$static);
 
-Irssi::EXPORT_ALL();
+  @Irssi::Channel::ISA = qw(Irssi::Windowitem);
+  @Irssi::Query::ISA = qw(Irssi::Windowitem);
 
-1;
+  Irssi::init();
+
+  Irssi::EXPORT_ALL();
+}
 
+1;