use 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; ### done ### ########################### # # # 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 report 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' ); ### done ### ############################ # # # 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 = ); } ### ### ########################## # # # 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; } # # # # # # # # # # # # 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; } # These next two need to be re-written for better flow. # They have multiple accessing subroutines and yet they # are designed only (really) for one. ^^;; My bad. It's # not so much the first one, but get_meta could be much # better. sub check_meta { print curti(), " Check meta: Checking meta...\n"; my @delta = parti(shift); # 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; } elsif ($delta[0] == 1 and $delta[1] < 30) { print curti(), " Check meta: Hit!\n"; return 1; } print curti(), " Check meta: Miss!\n"; return 0; } sub get_meta { my $dbh = DBI->connect( 'dbi:SQLite:dbname=mahou.db',undef,undef, { RaiseError => 1, AutoCommit => 0 } ); # check if we just want data my $hit = shift; my $data; print curti(), " Get meta: ", $hit ? "Coming from $hit.\n" : "Coming from finder.\n"; eval { # get meta from db my @meta = $dbh->selectrow_array('SELECT * from meta_data'); # for the meta_report function if ($hit) { print curti(), " Get meta: Meta aquired: @meta\n"; $data = \@meta; return; } # delete old meta, replace with new $dbh->do('DELETE FROM meta_data'); print curti(), " Get meta: Deleted old data.\n"; my $sth = $dbh->prepare('INSERT INTO meta_data values(?,?,?)'); $hit = check_meta($meta[2]); $hit ? ++$meta[0] : ++$meta[1]; $meta[2] = curti(); $sth->execute(@meta); $dbh->commit; print curti(), " Get meta: New data inserted: @meta\n"; }; if($@) { print curti(), " Get meta: Database error.\n"; $dbh->rollback; } print curti(), " Get meta: Meta check complete.\n"; $dbh->disconnect; return ($hit,$data); } # # # # # # # # # # # # # # # # # # # core sql search/writer thingies # # # # # # # # # # # # # # # # # # # sub sql_finder { # set need stuff, check metadata my (($hit,$time)$search,@data) = ((get_meta(undef)),shift,()); print curti(), " Sql finder: Hit: @{[ $hit ? 'yes' : 'no' ]} Search: $search\n"; # got a hit? PARSE IT! if ($hit) { print curti(), " Sql finder: Updating mahou_data...\n"; # this was the best line, left it for awesomeness # $dbh->disconnect; # ugh, sqlite sql_writer(); } # 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...\n"; $data[4] = fixti($data[4],$time); 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 'bgcolor', '#e9dfdb') ){ # first: get the name, for LINK: stays as hash; pc486! # second: get the ^^ 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'); } 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) ]}; } # 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... # What it was like before... Might work if I figure out the eval $_->[3] part. # map { return @{[ $_->[0], " than ", $_->[1] if $_->[2] eval $_->[3] } # [['greater','one hour',$conti,' > 1'],['etc']] ]} 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!