#!/usr/bin/perl
################################################################################
#                                                                              #
# ############################################################################ #
# # Title       : HTML::Scrape::Tie::WordStripped.pm                         # #
# # Description : See < HTML::Scrape::Tie::Word.pm >.                        # #
# # Coded by    : Justin "HEYO--!" Lee                                       # #
# # Version     : 01.02.00.10                                                # #
# # Date        : 2008-12-15                                                 # #
# # License     : GNU General Public License v.2                             # #
# #               Copyright (C) 2008  Justin Lee  <kool.name at gmail.com>   # #
# ############################################################################ #
#                                                                              #
# ############################################################################ #
# # This program is free software; you can redistribute it and/or            # #
# # modify it under the terms of the GNU General Public License version 2    # #
# # as published by the Free Software Foundation.                            # #
# #                                                                          # #
# # This program is distributed in the hope that it will be useful,          # #
# # but WITHOUT ANY WARRANTY; without even the implied warranty of           # #
# # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            # #
# # GNU General Public License for more details.                             # #
# #                                                                          # #
# # You should have received a copy of the GNU General Public License        # #
# # along with this program; if not, write to the Free Software              # #
# # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA            # #
# # 02110-1301, USA.  Or, see: <http://www.gnu.org/licenses/>                # #
# ############################################################################ #
#                                                                              #
################################################################################

package HTML::Scrape::Tie::WordStripped;

use lib join('/',split(/(?:\\|\/)+/,$ENV{'USERPROFILE'}),'library','perl'); # hax, needs to be changed
use strict;
use warnings;
use Carp;
use LWP::Simple;
use HTML::Scrape qw(put); # by pc486 <3

my %MACHINE = (
  'ZOKUTOU' => [
    { 'tag'     => 'table', # find table
      'require' => { 'width'       => qr/95%/,
                     'border'      => 2,
                     'align'       => qr/CENTER/i,
                     'cellpadding' => 8,
                     'cellspacing' => 0,
                     'bordercolor' => qr/85A1CC/i,
                     'bgcolor'     => qr/BABFFF/i } },
    { 'tag'  => 'h4' }, # find heading
    { 'text' => put('word') }, # grab text
  ],
);

## tie() methods below ##
sub TIESCALAR {
  my $c = shift; # class
  my $s = { # self
    'url'     => _sanity_check(shift),
    'machine' => _sanity_check(shift),
    'get'     => _sanity_check(int(shift or 1)),
  };

  croak 'Usage error' if @_; # expects no more vars

  unless (defined($s->{'url'})) {
    carp 'Undefined URL';
    undef($c); # fails defined($c)
  }
  if (defined($s->{'machine'})) {
    unless (exists($MACHINE{uc($s->{'machine'})})) {
      carp 'Invalid machine name';
      undef($c); # fails defined($c)
    }
    unless ($s->{'scraper'} = new HTML::Scrape ( Machine => $MACHINE{uc($s->{'machine'})} )) {
      carp 'HTML::Scrape failed';
      undef($c); # fails defined($c)
    }
  } else {
    carp 'No machine specified';
    undef($c); # fails defined($c)
  }
  unless ($s->{'get'} > 0 and $s->{'get'} < 4) {
    $s->{'get'} = 1;
  }
  unless (defined($c)) { # something failed, return 0
    carp 'Usage error';
    return 0;
  }
  return bless $s, $c;
}

sub FETCH {
  my $s = shift; # self
  my @w; # words

  ## this one is bad, don't play with your ties! ##
  confess 'Reference error' unless ref($s); # should be a hash

  croak 'Usage error' if @_; # expects no more vars

  for (my $i = $s->{'get'}; $i--; ) {
    push(@w,_scrape_url($s->{'url'},$s->{'scraper'}));

    sleep 1 if $i; # no sleeping if there's only one itteration
    croak 'Error on word ' . $#w . ' of ' . $s->{'get'};
  }
  _fisher_yates_shuffle(\@word) if @w > 1; # can only shuffle with >1
  return shift(@w); # return the first of the stack
}


sub STORE {
  my $s = shift; # self
  my $c = shift; # config

  ## this one is bad, don't play with your ties! ##
  confess 'Reference error' unless ref($s); # should be a hash

  croak 'Usage error' if @_; # expects no more vars
  carp 'On-the-fly configuration changes and other such wonderful things not yet implemented';
}

sub DESTROY {
  my $s = shift;

  ## this one is bad, don't play with your ties! ##
  confess 'Reference error' unless ref($s); # should be a hash

  croak 'Usage error' if @_; # expects no more vars
  undef($s);
}

## internal subs from here down ##
sub _scrape_url {
  my $u = shift; # url
  my $s = shift; # scraper
  my ($h,$w); # html and word scalars

  ## these two are bad, shouldn't happen ##
  confess 'URL not defined' unless defined($u);
  confess 'Scraper not defined' unless defined($s);

  unless ($h = get($u)) {
    carp 'Could not get HTML for: ' . $u;
    return undef; # get failed, let FETCH deal with it
  }
  return undef unless defined( $w = _scrape_parse( $s->scrape($h,1) ) ); # let FETCH deal with it
  return $w; # nothing failed, return word
}

sub _sanity_check {
  my $r = shift;
  return undef unless defined($r); # undef fails
  return undef if ref($r); # refs fail
  return $r; # nothing failed, return data
}

sub _scrape_parse {
  my $j = shift; # junk from HTML::Scrape ;)

  unless (defined($j)) { # make sure there is junk
    carp 'Scraped content not defined';
    return undef; # let _scrape_url() deal with it if there isn't
  }

  ## these two are bad, shouldn't happen ##
  confess "Weird error: @{[ ref($j) or 'No reference' ]}" unless ref($j) =~ /HASH/io;
  confess 'Weird error: Hash returned, no \'word\' field' unless exists($j->{'word'});

  unless ($j->{'word'} =~ /^(?:\s*\w+\s*)$/o) { # make sure there's a word
    carp 'Scraped content does not seem to be a word';
    return undef; # let _scrape_url() deal with it if there isn't
  }
  return $j->{'word'}; # hey! it worked, return the word
}

sub _fisher_yates_shuffle { # cookbook
  my $a = shift; # array ref
  my $i; # define $i
  for ($i = @$a; --$i; ) { # set $i = scalar @$a (length), -1 per itteration until 0
    my $j = int rand ($i+1); # set $j = random integer of $i + 1
    next if $i == $j; # if they're the same, skip
    @$a[$i,$j] = @$a[$j,$i]; # if they aren't, swap them
  }
}

1;