File Coverage

blib/lib/Bot/WootOff.pm

Criterion	Covered	Total	%
statement	55	124	44.3
branch	11	42	26.1
condition			n/a
subroutine	14	23	60.8
pod	2	9	22.2
total	82	198	41.4

###########################################
###########################################
package Bot::WootOff;
###########################################
###########################################
use strict;
use warnings;
use HTTP::Request::Common qw(GET);
use POE qw(Component::Client::HTTP);
use Log::Log4perl qw(:easy);

our $VERSION = "0.09";

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

  my $self = {
    irc_server       => "irc.freenode.net",
    irc_channel      => "#wootoff" . sprintf("%04d", int(rand(1000))),
    irc_nick         => "wootbot",
    http_alias       => "wootoff-ua",
    http_timeout     => 60,
    http_max_retries => 30,
    poll_interval    => 30,
    Alias            => "wootoff-bot",
    spawn            => 1,
    last_msg         => undef,
    %options,
  };

  bless $self, $class;

  $self->{http_agent} = $self->agent() unless defined $self->{http_agent};
  $self->{http_url}   = $self->woot_url() unless defined $self->{http_url};

  # Start it up automatically.
  $self->spawn() if $self->{spawn};

  return $self;
}

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

    return "http://www.woot.com";
}

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

    return(__PACKAGE__ . "/" . $VERSION),
}

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

  $self->{bot} = Bot::WootOff::Glue->new(
    server   => $self->{irc_server},
    channels => [ $self->{irc_channel} ],
    nick     => $self->{irc_nick},
  );

  POE::Component::Client::HTTP->spawn(
    Agent     => $self->{http_agent},
    Alias     => $self->{http_alias},
    Timeout   => $self->{http_timeout},
  );

  my $request = GET( $self->{http_url} );

  our $last_item = "";

  POE::Session->create(
    inline_states => {

      _start => sub {
        # wait at startup for things to settle down
        $poe_kernel->delay('http_start', 10);
      },

      http_start => sub {
        DEBUG "Requesting $self->{http_url}";
        POE::Kernel->post( $self->{http_alias},
          'request', 'http_ready', $request);
      },

      http_ready => sub {
        my $retries = 0;

        my $resp= $_[ARG1]->[0];
        if($resp->is_success()) {
          my $text = $resp->content();

          my($item, $price) = $self->html_scrape($text);

          if(! defined $item) {
              my $save_file = "/tmp/woot.html";

              if(open FILE, ">$save_file") {
                  print FILE $text;
                  close FILE;
              } else {
                 LOGWARN "Can't open $save_file ($!)";
              }

              if($self->{http_retries_performed} ==
                 $self->{http_max_retries}) {
                  LOGDIE "Ouch, woot.com changed their HTML, and our ",
                         "scraper failed (saved in $save_file). " ,
                         "Let the module author know!";
              } else {
                  ERROR "Scraper failed to parse HTML, but ",
                        "retrying (",
                        $self->{http_retries_performed} + 1,
                        "/",
                        $self->{http_max_retries},
                        ")";
                  $self->{http_retries_performed}++;
              }
          }

          $self->{http_retries_performed} = 0;

          if($last_item ne $item) {
              $last_item = $item;
              my $body = "$item $price $self->{http_url}";
              $self->{bot}->say(channel => $self->{irc_channel},
                                body    => $body);
              $self->{bot}->{last_msg} = $body;
              INFO "$item \$$price posted to $self->{irc_channel}";
          } else {
              DEBUG "Nothing changed";
          }

        } else {
          if(defined $resp->code()) {
              ERROR "HTTP fetch failed with code: ", $resp->code(),
               " ",
               (defined $resp->message() ? $resp->message() : "");
          }
        }
        $poe_kernel->delay("http_start", $self->{poll_interval} );
      },
    }
  );
}

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

    require LWP::UserAgent;
    my $ua = LWP::UserAgent->new();
    $ua->agent( $self->agent() );
    $self->error("");

    my $response = $ua->get( $self->woot_url() );

    if( $response->is_success() ) {
        my $bot = Bot::WootOff->new(spawn => 0);

        my($item, $price) = $bot->html_scrape( $response->content() );
        if(!defined $price) {
            $self->error("Scraper failed -- please notify the author");
            # use Sysadm::Install qw( :all );
            # blurt $response->content(), "test.html";
            return undef;
        } else {
            INFO "Scraper successfully got item and price";
            INFO "Item: [$item] Price: [$price]";
            return($item, $price);
        }
    }

    $self->error("Fetching woot.com page failed: ", $response->message());
    return undef;
}

###########################################
sub error {
###########################################
    my($self, @text) = @_;

    if(scalar @text) {
        $self->{error} = join ' ', @text;
        if(length $self->{error}) {
            ERROR $self->{error};
        }
    }

    return $self->{error};
}

###########################################
sub html_scrape {
###########################################
    my($self, $html) = @_;

      # Finds the item and its price in the woot.com HTML page
    my($item, $price);

    if($html =~ m#class="fn">(.*?)(.*?)
        ($item, $price) = ($1, $2);
    } elsif($html =~ m#class="fn">(.*?)\$(.*?)
        ($item, $price) = ($1, $2);
    } elsif( $html =~ m#(.*?)\s+\$(.*?)#s) {
          # fall back on legacy format
        ($item, $price) = ($1, $2);
    } elsif($html =~ m#class="title">(.*?)
          # min/max price ranges
        $item = $1;
        my @prices = ();

        while( $html =~ m#class="price.*?">\$(.*?)
            push @prices, $1;
        }

        $price = join " - ", @prices;
    }

    if(defined $item) {
        $item =~ s/\s+/ /g;
        return ($item, $price);
    }

    WARN "Cannot parse woot HTML";
    return undef;
}

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

    $self->{bot}->run();
}

###########################################
sub response_handler {
###########################################
  my ($request_packet, $response_packet) = @_[ARG0(), ARG1()];

  my $response_object = $response_packet->[0];

  print $response_object->content();
}

###########################################
###########################################
package Bot::WootOff::Glue;
###########################################
###########################################
use strict;
use warnings;
use Bot::BasicBot;
use base qw( Bot::BasicBot );
use Log::Log4perl qw(:easy);

###########################################
sub said {
###########################################
    my($self, $msg) = @_;

      # If someone says "!woot", repeat the last message
    if($msg->{body} =~ /^!woot/) {
        return $self->{last_msg} if defined $self->{last_msg};
    }

      # remain mum otherwise
    return "";
}

1;

__END__