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; ### ### #####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 = ); } ### ### ########################## # # # 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 @{[ undef,$_[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; print curti(), " Sql finder: Would have parsed.\n" if @{[ get_meta('query') ]}->[0]; # 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 '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'); } # 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) ]}; } # 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!