#!/usr/bin/perl
# This sample script will IM lines from a tailed file to $SEND_TO_SCREENNAME.
use strict;
use POE qw(Wheel::FollowTail Component::OSCAR);
my ($oscar);
# create a screenname for your script at http://www.aim.com
my $MY_SCREENNAME = 'A SCREENNAME';
my $MY_PASSWORD = 'A PASSWORD';
# all messages will be sent to:
my $SEND_TO_SCREENNAME = 'A SCREENNAME';
my $FILE_TO_TAIL = 'A FILENAME';
# only send errors matching these regular expressions (leave blank to send all
# lines)
my @ALLOW_REGEXES = ( qr/ERROR/ );
# ignore lines matching these regular expressions (leave blank to send all
# lines)
my @IGNORE_REGEXES = ( qr/mail/ );
POE::Session->create(
package_states => [
main => [qw(_start _stop im_in signon_done tail_in tail_error tail_reset)]
]
);
$poe_kernel->run();
sub _start {
# start the Oscar module with a throttle time of 4 second
$oscar = POE::Component::OSCAR->new( throttle => 4 );
# Oscar's 'signon_done' callback will call our state, 'signon_done', etc.
# See the Net::OSCAR docs for all the possible callbacks
$oscar->set_callback( signon_done => 'signon_done' );
$oscar->set_callback( im_in => 'im_in' );
$oscar->set_callback( error => 'error' );
$oscar->set_callback( admin_error => 'admin_error' );
$oscar->set_callback( rate_alert => 'rate_alert' );
$oscar->loglevel( 5 );
$oscar->signon( screenname => $MY_SCREENNAME, password => $MY_PASSWORD );
}
sub signon_done {
print "Signon done!\n";
# start tailing the file
HEAP->{wheel} = POE::Wheel::FollowTail->new(
Filename => $FILE_TO_TAIL,
Driver => POE::Driver::SysRW->new(),
Filter => POE::Filter::Line->new(),
PollInterval => 1,
InputEvent => 'tail_in',
ErrorEvent => 'tail_error',
ResetEvent => 'tail_reset',
);
}
sub tail_in {
my $msg = $_[ARG0];
for my $regex (@IGNORE_REGEXES) {
if ($msg =~ /$regex/) {
return;
}
}
for my $regex (@ALLOW_REGEXES) {
if ($msg =~ /$regex/) {
print "Sending to $SEND_TO_SCREENNAME: $msg\n";
$oscar->send_im( $SEND_TO_SCREENNAME => $msg );
return;
}
}
}
sub tail_error {
my ($operation, $errnum, $errstr, $wheel_id) = @_[ARG0..ARG3];
warn "Wheel $wheel_id generated $operation error $errnum: $errstr\n";
};
sub tail_reset {
warn "File reset";
}
sub im_in {
# first arg is empty; see the Net::OSCAR module for details about
# the other arguments
my $args = $_[ARG1];
my ($object, $who, $what, $away) = @$args;
print "Received from $who: $what\n";
}
sub error {
my $args = $_[ARG1];
my ($object, $connection, $error, $description, $fatal) = @$args;
warn("ERROR: $error / $description / $fatal");
}
sub admin_error {
my $args = $_[ARG1];
my ($object, $reqtype, $error, $errval) = @$args;
warn("ADMIN ERROR: $reqtype / $error / $errval");
}
sub rate_alert {
my $args = $_[ARG1];
my ($object, $level, $clear, $window, $worrisome) = @$args;
warn("RATE ALERT: $level / $clear / $window / $worrisome");
}
sub _stop {
}