rendered paste bodyuse LWP::Simple; # start! I wouldn't copy
use HTML::TreeBuilder; # anything seen in here,
use HTML::Entities; # it's for your own good
use DBI;
use DBD::SQLite;
use strict;
### ###
#####D#O#N#E###############
# #
# main hash and array #
# #
###########################
### ###
my %things = (
'help' => sub { print curti(), " - Commands: parse, find, time, exit, report\n" },
'find' => \&sql_finder,
'parse' => \&sql_writer, # I like the next one! \o/
'report' => sub { hash_report() and return if shift =~ /hash/; meta_report(); },
'time' => sub { print curti(), " There you go.\n" }
);
my @fields = (
'number',
'series', # why is @fields out here?
'season', # well billy, I just don't
'station', # know~! :) :P ;) xD <3 :3
'company',
'airtime',
'eta', # it's only used once, may
'eps', # as well ditch it soon :)
'links'
);
### ###
#####D#O#N#E################
# #
# heart of the progrum #
# #
############################
### ###
my $subjex = intro();
while($subjex !~ /exit/io){
foreach my $regex (sort keys %things) {
if($subjex =~ /^\s*($regex)(?:\s*(.*))?/i) {
$things{$1}->($2);
}
}
print curti(), " > ";
chomp($subjex = <STDIN>);
}
### ###
##########################
# #
# spiffy subroutines #
# #
##########################
### ###
#D#O#N#E# # # # # # # # #
# stuff for anidb links #
# # # # # # # # # # # # #
sub anidb_link { # makes pretty URLs
my $url = shift;
return '-' if !$url;
$url = 'http://anidb.info/a' . $url;
return $url;
}
sub anidb_id { # return AIDs
my $url = shift;
$url =~ s/^http.*aid.(\d+)$/$1/i;
return $url;
}
#D#O#N#E# # # # # # #
# sql stuff... ugh! #
# # # # # # # # # # #
sub build_hash {
my %showtime = {};
my $dbh = DBI->connect(
'dbi:SQLite:dbname=mahou.db',undef,undef,
{ RaiseError => 1, AutoCommit => 0 }
);
eval {
# build hash from mahou_data...
# someone should code this. ;-)
};
if($@) {
print curti(), " Build hash: Database error.\n";
}
$dbh->disconnect;
return 0;
}
sub check_meta {
my @delta = parti(pop);
print curti(), " Check meta: Checking meta...\n";
# first: hour is same, minutes > 30
# second: hour is + 1, minutes < 30
if ($delta[0] == 0 and $delta[1] > 30) {
print curti(), " Check meta: Hit!\n";
return @{[ 1,++$_[0],$_[1],curti() ]};
} elsif ($delta[0] == 1 and $delta[1] < 30) {
print curti(), " Check meta: Hit!\n";
return @{[ 1,++$_[0],$_[1],curti() ]};
}
print curti(), " Check meta: Miss!\n";
return @{[ 0,$_[0],++$_[1],curti() ]};
}
sub get_meta {
# hash of params for the check
my %type = (
'query' =>
{ 'return' => 0, 'update' => 1 },
'report' =>
{ 'return' => 1, 'update' => 0 }
); # this wasn't completely needed;
# it's here for scalability? ^^;
my $dbh = DBI->connect(
'dbi:SQLite:dbname=mahou.db',undef,undef,
{ RaiseError => 1, AutoCommit => 0 }
);
# check who sent for us
my ($from,$return) = (shift,[undef,[]]);
print curti(), " Get meta: Coming from $from, using method:";
foreach my $lol (keys %{$type{$from}}) {
print " $lol" if $type{$from}->{$lol};
} print "\n";
eval {
# get meta from db
@{$return->[1]} = @{[ $dbh->selectrow_array('SELECT * from meta_data') ]};
print curti(), " Get meta: Pre update: @{$return->[1]}\n";
if ($type{$from}->{'update'}) {
# check and get new meta
($return->[0],@{$return->[1]}) = check_meta(@{$return->[1]});
# delete old meta and get insert ready
$dbh->do('DELETE FROM meta_data');
print curti(), " Get meta: Deleted old data.\n";
my $sth = $dbh->prepare('INSERT INTO meta_data values(?,?,?)');
# insert and commit
$sth->execute(@{$return->[1]});
$dbh->commit;
}
};
if($@) {
print curti(), " Get meta: Database error.\n";
$dbh->rollback;
}
print curti(), " Get meta: Meta check complete, new meta: @{$return->[1]}\n";
$dbh->disconnect;
# only send back what we need
return \$return if $type{$from}->{'return'} and $type{$from}->{'update'};
return \@{$return->[1]} if $type{$from}->{'return'};
return $return->[0];
}
#D#O#N#E# # # # # # # # # # # # # #
# core sql search/writer thingies #
# # # # # # # # # # # # # # # # # #
sub sql_finder {
# set need stuff, check metadata
my $search = shift; my @data;
sql_writer() if get_meta('query');
# connect to db, finally
my $dbh = DBI->connect(
'dbi:SQLite:dbname=mahou.db',undef,undef,
{ RaiseError => 1, AutoCommit => 0 }
);
eval {
print curti(), " Sql finder: Starting search...\n";
# search, first checks for aid, then defaults to name
if($search =~ /^(?:ID:)?(\d+)$/) {
@data = $dbh->selectrow_array("SELECT * from mahou_data WHERE aid = $1");
} else {
$search = '%' . $search . '%';
my $sth = $dbh->prepare('SELECT * from mahou_data WHERE name like ?');
$sth->execute($search);
@data = $sth->fetchrow_array;
}
if(@data) {
print curti(), " Sql finder: Adjusting time from: $data[4]\n";
$data[4] = fixti($data[4]);
print curti(), " Query Data:\n";
print " $_\n" foreach @data;
} else {
print curti(), " Query Data: No results.\n";
}
};
if($@) {
print curti(), " Sql finder: Database error.\n";
}
$dbh->disconnect;
}
sub sql_writer {
print curti(), " Sql writer: Getting hash...\n";
# grab hash from parser and connect to db
my $hash = core_parse();
print curti(), " Sql writer: Connecting and preparing insert.\n";
my $dbh = DBI->connect(
'dbi:SQLite:dbname=mahou.db',undef,undef,
{ RaiseError => 1, AutoCommit => 0 }
);
eval {
# clear table, prepare insert
$dbh->do('DELETE FROM mahou_data');
my $sth = $dbh->prepare('INSERT INTO mahou_data values(?,?,?,?,?)');
# insert
print curti(), " Sql writer: Inserting rows.\n";
foreach my $anime (sort keys %{$hash}) {
$sth->execute($anime,@{[ map { $hash->{$anime}{$_} } ('link','station','airtime','eta') ]});
}
$dbh->commit;
};
if($@) {
$dbh->rollback;
print curti(), " Sql writer: Database error.\n";
}
$dbh->disconnect;
print curti(), " Sql writer: Database updated.\n";
}
#D#O#N#E# # # # # # # # # # # #
# download, parse and related #
# # # # # # # # # # # # # # # #
sub table_header_has {
my ($table, $str) = @_;
return defined $table->look_down(
'_tag', 'th',
sub { $_[0]->as_text() eq $str }
);
} # by pc486
sub core_parse {
# build tree, get shit from it ^-^
print curti(), " Core parse: Starting parser...\n";
my ($html,%showtime) = (get("http://mahou.org/Showtime"),{});
$html = HTML::TreeBuilder->new_from_content($html);
# first step: find time table
print curti(), " Core parse: Searching for table...\n";
my $table = $html->look_down(
'_tag', 'table',
'bgcolor', '#bfa89b',
sub { table_header_has($_[0], "ETA") },
sub { not table_header_has($_[0], "Starting") }
); # by pc486
# second step: find ACTUAL time table
print curti(), " Core parse: Constructing hash...\n";
foreach my $anime ($table->look_down(
'_tag', 'tr',
'align', undef, # skip first <tr>
'bgcolor', '#e9dfdb')
){
# first: get the name, for LINK: stays as hash; pc486!
# second: get the ^<RIGHT>^ link (which is kinda good)
my $name = $anime->look_down('_tag', 'a', 'name', qr/\d+/)->parent();
my $link = $name->parent()->look_down('_tag', 'a', 'href', qr/anidb/);
# starts the hash (with an aid), then populates it with map
$showtime{$name->as_text}->{'link'} = $link ? anidb_id($link->{'href'}) : undef;
map { $showtime{$name->as_text}->{$fields[$_]} =
@{[ $anime->look_down('_tag', 'td') ]}[$_]->as_text } (3,5,6);
}
$html->delete;
print curti(), " Core parse: Returning hash to parent...\n";
return \%showtime;
}
#D#O#N#E# # # # # # # #
# stuff for the idler #
# # # # # # # # # # # #
sub meta_report {
print curti(), " Meta report: Initializing...\n";
my $meta = get_meta('report');
print curti(), " Mahou Meta Report:\n",
" re-parse hits -> @{[ $meta->[0] ]}\n",
" re-parse misses -> @{[ $meta->[1] ]}\n",
" time since last -> @{[ cheti(parti($meta->[2])) ]}\n";
}
sub intro {
print ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::\n",
"::::::::: :::::::::\n",
"::::::::: Welcome to the Mahou.org/Showtime parser! :::::::::\n",
"::::::::: :::::::::\n",
"::::::::: `Being dumb since 1823!` :::::::::\n",
"::::::::: `Or something.` :::::::::::::::::::\n",
"::::::::: ::By: Dean_Kreger::\n",
":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::\n";
return('help');
}
# I may do this if I get bored...
sub hash_report {
my %showtime = {};
my $lol = build_hash(); # returns zero
if ($lol) {
foreach my $anime (sort keys %showtime) {
print "$anime <-<+>-> ", anidb_link($showtime{$anime}->{'link'}),
"\n Station -> ", $showtime{$anime}->{'station'},
"\n Airtime -> ", $showtime{$anime}->{'airtime'},
"\n ETA -> ", $showtime{$anime}->{'eta'}, "\n\n";
}
}
print curti(), " The hash report function has yet to be implemented.\n";
}
# # # # # # # # # # # # # # # # # # #
# kawaii~ time related subroutines~ #
# # # # # # # # # # # # # # # # # # #
### ## ## ## ## ## ## ## ## ###
# These were my play things. :) <3 #
### ## ## ## ## ## ## ## ## ###
sub fixti {
my %fixti; my @curti = split(/:/,curti());
map { $fixti{chop($_)} = $_ } @{[ split(/\s+/,shift) ]};
return "working on it...";
} # fixes the time... DEAN'S WAY!
sub cheti {
my $conti = shift;
return "update already! it's been like a day or more" if $conti < 0;
return "more than five hours... I think..." if $conti > 5;
return "like... more than an hour, at least" if $conti > 1;
return "pretty much less than an hour" if $conti <= 1;
return "erroneous check; please replace coder";
} # checks the time... DEAN'S WAY! ... Sorta...
sub parti {
my @parti; push(@parti,shift);
my @curti; push(@curti,curti());
print curti(), " Parti: Doing: @curti - @parti\n";
map { @$_ = split(/:/,$_->[0]) } (\@parti,\@curti);
return @{[ map { $curti[$_] - $parti[$_] } (0,1,2) ]};
} # parses the time... DEAN'S WAY!
sub curti {
my @time = @{[ gmtime ]}[2,1,0];
$time[0] = $time[0]-3 < 0 ? $time[0]+9 : $time[0]-3;
return sprintf("%02d:%02d:%02d", @time);
} # gets the time... DEAN'S WAY!