File Coverage

blib/lib/Bot/Webalert.pm

Criterion	Covered	Total	%
statement	42	68	61.7
branch	3	12	25.0
condition	3	9	33.3
subroutine	11	15	73.3
pod	2	6	33.3
total	61	110	55.4

###########################################
package Bot::Webalert;
###########################################
use strict;
use warnings;
use Bot::BasicBot;
use Log::Log4perl 1.05 qw(:easy);
use POE;
use POE::Component::Client::HTTP;
use HTTP::Cookies;
use base qw( Bot::BasicBot );

our $VERSION = "0.01";

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    %options = (
        nick => "webalert-bot",
        %options,
    );

    if(! exists $options{server} or
       ! exists $options{channels} or
       ! exists $options{ua_request} ) {
       LOGDIE "Missing mandatory parameters server/channels/ua_request";
    }

    my $self = $class->SUPER::new(
        map { $_ => $options{ $_ } } qw(server channels nick),
    );

    $self = {
        alias                   => "webalert-bot",
        ua_fetch_interval       => 60*60, # every hour
        ua_timeout              => 60,
        ua_alias                => "webalert-bot-fetcher",
        ua_callback             => \&default_callback,
        ua_request              => undef,
        default_callback_status => undef,
        %options,
        %$self,
    };

    # re-bless
    bless($self, $class);

    if(! defined $self->{ua_request}) {
       LOGDIE "Missing mandatory parameters ua_callback/ua_request";
    }

    $self->spawn();

    return $self;
}

###########################################
sub spawn {
###########################################
    my($self) = @_;

  if( POE::Kernel->alias_resolve( $self->{ua_alias} ) ) {
      DEBUG "Not spawning $self->{ua_alias} session (there's one already)";
      return 1;
  }

  DEBUG "Spawning POE::Component::Client::HTTP aliased '$self->{ua_alias}'";

      # Spawn the UA with a cookie jar
  POE::Component::Client::HTTP->spawn(
    Alias     => $self->{ua_alias},
    Timeout   => $self->{ua_timeout},
    CookieJar => HTTP::Cookies->new(),
  );

  POE::Session->create(
    object_states => [
      $self => {
        _start     => "_start",
        http_start => "http_start",
        http_ready  => "http_ready",
      }
    ]
  );
}

###########################################
sub _start {
###########################################
    my($self) = @_;

      # Wait 20 secs before the first fetch
    POE::Kernel->delay('http_start', 20);
}

###########################################
sub http_start {
###########################################
    my($self) = @_;

    DEBUG "Fetching url ", $self->{ua_request}->url->as_string();
    POE::Kernel->post($self->{ua_alias}, "request",
        "http_ready", $self->{ua_request});
    POE::Kernel->delay('http_start',
        $self->{ua_fetch_interval});
}

###########################################
sub http_ready {
###########################################
    my($self) = @_;

    DEBUG "http_ready ", $self->{ua_request}->url->as_string();
    my $resp= $_[ARG1]->[0];

    my $cb_string = $self->{ua_callback}->( $resp, $self );

    if(defined $cb_string) {
        INFO "Sending '$cb_string' to $self->{channels}->[0]";
        $self->say(channel => $self->{channels}->[0],
            body    => $cb_string,
        );
    } else {
        DEBUG "Callback returned undef (no message to IRC)";
    }

    POE::Kernel->alias_set( $self->{alias} );
}

###########################################
sub default_callback {
###########################################
    my($response, $bot) = @_;

    if($response->is_success()) {
        if(! defined $bot->{default_callback_status} or
           $bot->{default_callback_status} ne $response->content()) {
           $bot->{default_callback_status} = $response->content();
           return $response->request->url->as_string() . " has changed!";
       }
    }

    return undef;
}

###########################################
sub log {
###########################################
    my($self, @msgs) = @_;

    local $Log::Log4perl::caller_depth;
    $Log::Log4perl::caller_depth++;

    DEBUG @msgs;
}

1;

__END__