File Coverage

blib/lib/Scrabble/Dict.pm

Criterion	Covered	Total	%
statement	30	32	93.7
branch	3	8	37.5
condition	5	15	33.3
subroutine	7	9	77.7
pod	4	4	100.0
total	49	68	72.0

package Scrabble::Dict;

use base qw/Exporter/;
use LWP::UserAgent;
use strict;

our @EXPORT_OK = qw/scrabble_define/;
our $VERSION = '0.01';

my %defaults = (
  host => 'www.hasbro.com',
  uri_home => '/games/adult-games/scrabble/home.cfm',
  uri_dict => '/games/adult-games/scrabble/home.cfm?page=Dictionary/dict',
  undefined_as => ''
);

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my %init = @_ & 1 ? die "argument hash expected" : @_;

  my $self = {
    _host         => delete $init{host}         || $defaults{host},
    _uri_home     => delete $init{uri_home}     || $defaults{uri_home},
    _uri_dict     => delete $init{uri_dict}     || $defaults{uri_dict},
    _undefined_as => delete $init{undefined_as} || $defaults{undefined_as},
  };

  $self->{_ua} = LWP::UserAgent->new(%init, cookie_jar => {});

  return bless $self => $class;
}

sub define {
  my ($self, $word) = (shift, lc shift);
  my $ua = $self->{_ua};

  my %param = (
    type => 'dictionary',
    exact => 'on',
    Word => $word
  );

  # hasbro site forces us to eat ColdFusion cookies the first time

  my $url_home = "http://$self->{_host}$self->{_uri_home}";
  my $cookie_scan = sub { $_[1] eq 'CFID' && $_[4] eq $self->{_host} };

  $ua->get($url_home) if not $ua->cookie_jar->scan($cookie_scan);

  my $url_dict = "http://$self->{_host}$self->{_uri_dict}";
  my $html = '';

  $ua->post($url_dict, \%param, ':content_cb' => sub { $html .= shift });

  return $self->scrape_definition($html, $word);
}

sub scrape_definition {
  my ($self, $html, $word) = (shift, shift, shift);

  return $1 if $html =~
    m{
        .*?

          \Q$word\E .*? \\ \s+ (.*?)

        .*?
      }xsm;

  return $self->{_undefined_as};
}

sub scrabble_define {
  my $word = shift;
  return __PACKAGE__->new(@_)->define($word);
}

1;

__END__