##########[ ircpipe starts here ]##########
#!/usr/bin/perl
use warnings;
use strict;
use Fcntl qw( :DEFAULT :flock );
use Getopt::Long;
# The FIFO ircpiped listens on.
my $fifo = "$ENV{HOME}/.ircpipe.fifo";
my ($server, $to);
my $help;
my $ok = GetOptions(
"fifo=s" => \$fifo,
"server=s" => \$server,
"to=s" => \$to,
"help" => \$help
);
if(!$ok or !$server or !$to or $help) {
print STDERR <<USAGE;
ircpipe -- Trigger ircpiped to send a message
Usage: $0 [--fifo=~/.ircpipe.fifo] [--help] --server=host[:port] --to=
+#channel [files]
Options:
--fifo=~/.ircpipe.fifo Sets the FIFO ircpiped listens on.
Important: ircpiped has to be started
using the same FIFO.
--help Displays this message.
--server=host[:port] Sets the server to connect to. port defa
+ults to
6667.
--to=#channel or Sets the recipient.
--to=nick
Non-option arguments are taken to be filenames which should be sent. I
+f no
file's specified, ircpipe reads from STDIN.
Options may be abbreviated to uniqueness.
USAGE
exit;
}
# Default $port to 6667.
my ($host, $port) = split /:/, $server;
$port ||= 6667;
# Open the FIFO and lock it exclusively. See perldoc -q lock.
sysopen my $fh, $fifo, O_RDWR|O_CREAT
or die "Couldn't open $fifo: $!\n";
flock $fh, LOCK_EX
or die "Couldn't flock $fifo: $!\n";
while(<>) {
chomp;
print $fh join(":", $host, $port, $to, $_) . "\n"
or die "Couldn't write to $fifo: $!\n"
}
close $fh
or die "Couldn't close $fifo: $!";
exit;
##########[ ircpipe ends here ]##########
##########[ ircpiped starts here ]##########
#!/usr/bin/perl
use warnings;
use strict;
use POE qw( Wheel::FollowTail );
use POSIX qw( strftime );
use Term::ANSIColor
qw( color );
use Getopt::Long;
# Hash of Bot objects
my %bot;
# FIFO and nick to use.
my $fifo = "$ENV{HOME}/.ircpipe.fifo";
my $nick = "ircpipe";
# Need help?
my $help;
# Hackery: $verbose is global, so our package Bot has access to it, to
+o.
our $verbose;
my $ok = GetOptions(
"fifo=s" => \$fifo,
"nick=s" => \$nick,
"help" => \$help,
"verbose" => \$verbose
);
if(!$ok or $help) {
print STDERR <<USAGE;
ircpiped -- Daemon part of ircpipe
Usage: $0 [--fifo=~/.ircpipe.fifo] [--nick=ircpipe] [--verbose] [--hel
+p]
Options:
--fifo=~/.ircpipe.fifo Sets the FIFO to listen on
--nick=ircpipe Sets the nick to use
--verbose Be verbose
--help Displays this message
Options may be abbreviated to uniqueness.
USAGE
exit;
}
POE::Session->create(
inline_states => {
_start => \&fifo_start,
got => \&fifo_got,
},
);
POE::Kernel->run;
exit;
# Nice formatting... But only if the user set --verbose.
sub info ($) {
printf STDERR "[%s%s%s] %s%s%s: %s%s%s\n",
color("bold white"),
strftime("%d.%m.%y/%H:%M:%S", localtime),
color("reset"),
color("bold yellow"),
"fifo",
color("reset"),
color("bold magenta"),
$_[0],
color("reset")
if $verbose or $_[1];
}
sub fifo_start {
info "Listening on named pipe $fifo...";
$_[HEAP]->{fifo} = POE::Wheel::FollowTail->new(
Filename => $fifo,
InputEvent => "got",
);
}
sub irc_start {
# This sub fires up a Bot. Bot::new expects the hostname, portnumber
+, and
# nickname to use as parameters. $_[0] is sth. like "thestars:6667",
+ so we've
# to split it.
$bot{$_[0]} = Bot->new(split(/:/, $_[0]), $nick);
}
sub fifo_got {
my $line = $_[ARG0];
# Example input line:
# thestars:6667:#channel:Hello
$line =~ /^([^:]+):([^:]+):([^:]+):(.+)$/ or do {
info "Malformed input line: \"$line\"";
return;
};
my ($server, $to, $msg) = ("$1:$2", $3, $4);
# Fire up a Bot if not already done.
$bot{$server} or irc_start($server);
# Connect to the server if not already done.
$bot{$server}->connected or $bot{$server}->connect;
# Join if not already joined.
$bot{$server}->joined($to) or $bot{$server}->join($to)
if $to =~ /^[#&+]/;
# Send.
$bot{$server}->privmsg($to => $msg);
}
package Bot;
use warnings;
use strict;
use POE qw( Component::IRC::Tracking );
use POSIX qw( strftime );
use Term::ANSIColor
qw( color );
use Text::Wrap
qw( wrap);
# IRCNAME is the realname information shown in /WHOIS
use constant IRCNAME => "POE::Component::IRC::Tracking power
+ed ircpipe";
# 255 is the historical line length limit. "PRIVMSG #to :" counts too,
+ so we
# say 200 and are likely safe.
use constant MAX_SEND_LEN => 200;
# Nice formatting... But only if the user set --verbose.
sub info {
my ($self, $msg, $force) = @_;
printf STDERR "[%s%s%s] %s%s%s@%s%s%s: %s%s%s\n",
color("bold white"),
strftime("%d.%m.%y/%H:%M:%S", localtime),
color("reset"),
color("bold yellow"),
$self->botheap->{nick} || "no nick",
color("reset"),
color("bold red"),
$self->server,
color("reset"),
color("bold magenta"),
$msg,
color("reset")
if $::verbose or $force;
}
sub new {
my ($class, $host, $port, $nick) = @_;
my $self = bless [] => $class;
local $_;
($self->host, $self->port, $self->server, $self->nick) =
($host, $port, "$host:$port", $nick);
# $self->perform is an arrayref of coderefs which are executed upon
+reception
# of 376 (End of /MOTD).
$self->perform = [];
$self->sid = POE::Session->create(
object_states => [
$self => {
_start => "bot_start",
connect => "bot_connect",
# We don't *need* those events, they're mostly only for debugging.
map {($_)x2} qw(
irc_connected irc_376
irc_ctcp_ping
irc_invite irc_474
irc_socketerr irc_disconnected
),
},
],
)->ID;
return $self;
}
# C<botheap> returns the HEAP of PoCo::IRC::Tracking
sub botheap { POE::Kernel->alias_resolve($_[0]->bot)->get_heap }
# Are we connected?
sub connected { $_[0]->botheap->{connected} and $_[0]->seen_376 }
# Are we on channel C<$_[1]>?
sub joined { $_[0]->connected and $_[0]->botheap->{channels}->{$_[1]}
+}
# Join a channel.
sub join {
my ($self, $chan) = @_;
return if $self->joined($chan);
if($self->connected) {
# If we're connected, join.
$self->info("Joining $chan...");
POE::Kernel->post($self->bot, sl_login => "JOIN $chan");
} else {
# If not, we've to queue the join.
# $self->perform is an arrayref of coderefs which are executed upo
+n
# reception of 376 (End of /MOTD).
push @{ $self->perform }, sub { $self->join($chan) };
}
}
# Send a msg.
sub privmsg {
my ($self, $to, $msg) = @_;
if($self->connected) {
# Same game as above, send immediately if we're connected, else qu
+eue.
$self->info("Sending \"$msg\" to $to...");
# Why local? As soon as this block is left, the original values ar
+e
# recovered. So, if the programmer uses Text::Wrap, we don't reset
+ his
# settings.
local $Text::Wrap::columns = MAX_SEND_LEN;
local $Text::Wrap::huge = "wrap";
# Ok, send...
local $_;
POE::Kernel->post($self->bot, sl_login => "PRIVMSG $to :$_")
for split /\n/, wrap("", "", $msg);
} else {
# Queue.
push @{ $self->perform }, sub { $self->privmsg($to => $msg) };
}
}
sub bot_start {
my $self = $_[OBJECT];
# Fire up the bot...
POE::Component::IRC::Tracking->new($self->bot = "bot/$self");
# $self->bot keeps the alias of the PoCo.
# ...and register all events. We don't need all, this is mainly for
# convenience.
POE::Kernel->post($self->bot, register => "all");
}
# This sub wraps the POE event in a nice OO method.
sub connect { POE::Kernel->post($_[0]->sid, connect => @_[1..$#_]) }
sub bot_connect {
my $self = $_[OBJECT];
$self->info("Connecting...");
POE::Kernel->post($self->bot, connect => {
Server => $self->host,
Port => $self->port,
Nick => $self->nick,
Username => $self->nick,
Ircname => IRCNAME,
});
# $self->seen_376 is true if we received End of /MOTD, e.g. if we're
+ inside.
# Reset it for now.
$self->seen_376 = 0;
}
# We get this event if the socket is successfully connected.
sub irc_connected {
my $self = $_[OBJECT];
$self->info("Socket connected.");
}
# 376: End of /MOTD.
# Process $self->perform.
sub irc_376 {
my $self = $_[OBJECT];
$self->info("Inside (got 376 event).");
# Set $senf->seen_376 to a true value.
$self->seen_376++;
local $_;
&$_ for splice @{ $self->perform };
# splice @array returns @array and empties it.
}
# We are banned?
sub irc_474 {
my $self = $_[OBJECT];
my $msg = $_[ARG1];
$msg =~ /^([^ ]+) :(.*)$/ or return;
$self->info("Couldn't join channel $1: \"$2\"");
}
# Answer to CTCP PINGs.
sub irc_ctcp_ping {
my $self = $_[OBJECT];
my ($mask, undef, $ping) = @_[ARG0..$#_];
$self->info("Got CTCP-PINGed from $mask.");
# Don't answer to "special things" (thing without a nickname).
$mask =~ /^([^!]+)/ or return;
# Why don't we use PoCo::IRC's ctcp_reply here?
# Reason: We want the PING-reply to be sent out as soon as possible.
# PoCo::IRC's default priority of ctcp_reply is too low.
POE::Kernel->post($self->bot, sl_login => "NOTICE $1 :\001PING $ping
+\001");
}
# Accept invitations.
sub irc_invite {
my $self = $_[OBJECT];
$self->info("Got invitation to $_[ARG1] from $_[ARG0].");
$self->join($_[ARG1]);
}
# The connection got lost, notify the user.
sub irc_socketerr { $_[0]->info("Socket error.") }
sub irc_disconnected { $_[0]->info("Connection lost.") }
sub host : lvalue { $_[0]->[0] }
sub port : lvalue { $_[0]->[1] }
sub server : lvalue { $_[0]->[2] }
sub nick : lvalue { $_[0]->[3] }
sub sid : lvalue { $_[0]->[4] }
sub bot : lvalue { $_[0]->[5] }
sub perform : lvalue { $_[0]->[6] }
sub seen_376 : lvalue { $_[0]->[7] }
# That's all.
1;
#########[ ircpiped ends here ]##########
In reply to ircpipe
by iblech
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
- a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
| |
For: |
|
Use: |
| & | | & |
| < | | < |
| > | | > |
| [ | | [ |
| ] | | ] |
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.