diff --git a/src/perl/common/Irssi.pm b/src/perl/common/Irssi.pm index 14d3f4dc..4ef0db10 100644 --- a/src/perl/common/Irssi.pm +++ b/src/perl/common/Irssi.pm @@ -5,8 +5,101 @@ 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" @@ -14,8 +107,20 @@ 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}; + } + } + select CLIENTCRAP; } sub in_irssi { @@ -37,7 +142,8 @@ require DynaLoader; MSGLEVEL_CLIENTERROR MSGLEVEL_HILIGHT MSGLEVEL_ALL MSGLEVEL_NOHILIGHT MSGLEVEL_NO_ACT MSGLEVEL_NEVER MSGLEVEL_LASTLOG ); -@EXPORT_OK = qw(); + +require Irssi::TieHandle; my $static = 0; @@ -60,4 +166,3 @@ if (!in_irssi()) { } 1; - diff --git a/src/perl/ui/UI.pm b/src/perl/ui/UI.pm index 5bab7b6b..83b9ef29 100644 --- a/src/perl/ui/UI.pm +++ b/src/perl/ui/UI.pm @@ -12,6 +12,10 @@ $VERSION = "0.9"; require Exporter; require DynaLoader; +sub Irssi::UI::Window::create_handle { + goto &Irssi::create_window_handle; +} + @ISA = qw(Exporter DynaLoader); @EXPORT = qw(); @EXPORT_OK = qw();