/usr/share/doc/libpoe-component-irc-perl/examples/simpleclient.pl is in libpoe-component-irc-perl 6.88+dfsg-1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | #!/usr/bin/perl -w
use Getopt::Long;
use POE qw(Component::IRC::State Wheel::ReadLine);
use Data::Dumper;
$Data::Dumper::Indent = 1;
my $nick;
my $user;
my $server;
my $port;
my $ircname;
my $password;
my $current_channel;
my $socks_proxy;
my $socks_port;
my $socks_id;
my $no_dns;
GetOptions(
"nick=s" => \$nick,
"server=s" => \$server,
"user=s" => \$user,
"port=s" => \$port,
"pass=s" => \$password,
"socksproxy=s" => \$socks_proxy,
"socksport=s" => \$socks_port,
"socksuser=s" => \$socks_id,
"ircname=s" => \$ircname,
"nodns" => \$no_dns,
);
die unless $nick and $server;
print "$nick $server\n";
my $irc = POE::Component::IRC::State->spawn( Nick => $nick, Server => $server, Port => $port, Ircname => $ircname, Username => $user, Password => $password, socks_proxy => $socks_proxy, socks_port => $socks_port, socks_id => $socks_id, NoDNS => $no_dns );
print STDOUT $irc->version(), "\n";
POE::Session->create(
package_states => [
'main' => [ qw(_start _stop got_input parse_input _default irc_public) ],
],
);
$poe_kernel->run();
exit 0;
sub _start {
my $heap = $_[HEAP];
$heap->{readline_wheel} =
POE::Wheel::ReadLine->new( InputEvent => 'got_input' );
$heap->{readline_wheel}->get("> ");
$irc->yield( register => 'all' );
undef;
}
sub _stop {
delete $_[HEAP]->{readline_wheel};
$irc->yield( unregister => 'all' );
$irc->yield( 'shutdown' );
undef;
}
sub got_input {
my ( $heap, $kernel, $input, $exception ) = @_[ HEAP, KERNEL, ARG0, ARG1 ];
if ( defined $input ) {
$heap->{readline_wheel}->addhistory($input);
#$heap->{readline_wheel}->put("I heard $input");
$kernel->yield( 'parse_input' => $input );
}
elsif ( $exception eq 'interrupt' ) {
$heap->{readline_wheel}->put("Goodbye.");
delete $heap->{readline_wheel};
$irc->yield( unregister => 'all' );
$irc->yield( 'shutdown' );
return;
}
else {
$heap->{readline_wheel}->put("\tException: $exception");
if ( $exception eq 'eot' ) {
$irc->yield( unregister => 'all' );
$irc->yield( 'shutdown' );
delete ( $heap->{readline_wheel} );
}
}
$heap->{readline_wheel}->get("> ") if ( $heap->{readline_wheel} );
undef;
}
sub parse_input {
my ($kernel, $heap, $input) = @_[KERNEL,HEAP,ARG0];
# Parse input
if ( $input =~ /^\//) {
$input =~ s/^\///;
my (@args) = split(/ /,$input);
my ($cmd) = shift @args;
SWITCH: {
if ( $cmd eq 'connect' ) {
if ( $irc->connected() ) {
$heap->{readline_wheel}->put("Already connected");
last SWITCH;
}
$heap->{readline_wheel}->put("Connecting");
$irc->yield( 'connect' );
last SWITCH;
}
if ( $cmd eq 'dump_state' ) {
unless (@args) {
$heap->{readline_wheel}->put($_) for split /\n/, Dumper($irc->{STATE});
} else {
open my $fh, ">", $args[0] or return;
print $fh Dumper($irc->{STATE});
}
last SWITCH;
}
if ( $cmd eq 'sl' or $cmd eq 'quote' ) {
$irc->yield( $cmd => join ( ' ', @args ) );
} else {
$irc->yield( $cmd => @args );
}
$heap->{readline_wheel}->put($cmd . " " . join(' ',@args) );
}
}
undef;
}
sub _default {
my ( $event, $args ) = @_[ ARG0 .. $#_ ];
my (@output);
my $arg_number = 0;
foreach (@$args) {
SWITCH: {
if ( ref($_) eq 'ARRAY' ) {
push ( @output, "[", join ( ", ", @$_ ), "]" );
last SWITCH;
}
if ( ref($_) eq 'HASH' ) {
push ( @output, "{", join ( ", ", %$_ ), "}" );
last SWITCH;
}
push ( @output, "'$_'" );
}
$arg_number++;
}
$_[HEAP]->{readline_wheel}->put("$event " . join(' ',@output) ) if ( defined ( $_[HEAP]->{readline_wheel} ) );
return 0; # Don't handle signals.
}
sub irc_public {
my ($kernel,$heap,$who,$where,$what) = @_[KERNEL,HEAP,ARG0,ARG1,ARG2];
my ($nick) = ( split /!/, $who )[0];
my ($chan) = $where->[0];
$heap->{readline_wheel}->put($chan . ':<' . $nick . '> ' . $what);
undef;
}
|