#!/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;