All pastes #577516 Raw Edit

v0.0.2

public text v1 · immutable
·published 2007-06-19 22:58 UTC
rendered paste body
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;


 ###                     ###
 ###########################
  #                       #
   # main hash and array #
  #                       #
 ###########################
 ###                     ###

my %things = (
  'help'   => sub { print curti(), " - Commands: parse, find, time, exit\n" },
  'find'   => \&sql_finder,
  'parse'  => \&sql_writer,
  'report' => \&super_report,
  'time'   => sub { print curti(), "\n" }
);
my @fields = (
  'number',
  'series',
  'season',
  'station',
  'company',   # why is @fields out here?
  'airtime',   # well billy, I just don't
  'eta',       # know~! :) :P ;) xD <3 :3
  'eps',
  'links'
);



 ###                      ###
 ############################
  #                        #
   # 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>);
}


 ###                  ###
 ########################
  #                    #
   # core subroutines #
  #                    #
 ########################
 ###                  ###

   # # # # # # # # # # # # #
   # 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 the showtime hash from pk info of mahou_data (anime title)
    map { $showtime{$_} = {} } $dbh->primary_key( undef,undef,'mahou_data' );
    my $sth = $dbh->prepare('SELECT * FROM mahou_data WHERE name = ?');
    foreach my $lol (sort keys %showtime) {
      $sth->execute($lol);
      print curti(), $sth->fetchrow_array, "\n";
    }
  };
  if($@) {
    print curti(), " Database error.\n";
  }
  $dbh->disconnect;
}

sub check_meta {
  print curti(), " Checking meta...\n";
  my @delta = parti(shift);

  # first: hour is same, minutes > 15
  # second: hour is + 1, minutes < 45
  if ($delta[0] == 0 and $delta[1] > 15) {
    print curti(), " Hit!\n";
    return 1;
  } elsif ($delta[0] == 1 and $delta[1] < 45) {
    print curti(), " Hit!\n";
    return 1;
  }
  print curti(), " Miss!\n";
  return 0;
}

sub get_meta {
  my $dbh = DBI->connect(
    'dbi:SQLite:dbname=mahou.db',undef,undef,
    { RaiseError => 1, AutoCommit => 0 }
  );
  eval {
    # get meta from db
    my @meta = $dbh->selectrow_array('SELECT * from meta_data');

    # delete old meta, replace with new
    $dbh->do('DELETE FROM meta_data');
    my $sth = $dbh->prepare('INSERT INTO meta_data values(?,?,?)');
    my $hit = check_meta($meta[2]);
    $hit ? ++$meta[0] : ++$meta[1];
    $meta[2] = curti();
    $sth->execute(@meta);
    $dbh->commit;
  };
  if($@) {
    print curti(), " Metatable error.\n";
    $dbh->rollback;
}


   # # # # # # # # # # # # # # # # # #
   # core sql search/writer thingies #
   # # # # # # # # # # # # # # # # # #

sub sql_finder {
  # set need stuff, check metadata
  my ($hit,$search,@data) = (get_meta(),shift,());

  # got a hit? PARSE IT!
  if ($hit) {
    # 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 {
    # 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(), " Data:\n";
      print "          $_\n" foreach @data;
    }
    print curti(), " Search done.\n";
  };
  if($@) {
    print curti(), " Search error.\n";
  }
  $dbh->disconnect;
}

sub sql_writer {
  # grab hash from parser and connect to db
  my $hash = core_parse();
  print curti(), " Starting write.\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
    foreach my $anime (sort keys %{$hash}) {
      $sth->execute($anime,@{[ map { $hash->{$anime}{$_} } ('link','station','airtime','eta') ]});
    }
    $dbh->commit;
  };
  if($@) {
    $dbh->rollback;
    print curti(), " Error.\n";
  }
  
  $dbh->disconnect;
  print curti(), " Database closed.\n";
}


   # # # # # # # # # # # # # # # #
   # 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(), " Starting parser.\n";
  my ($html,%showtime) = (HTML::TreeBuilder->new_from_file("Showtime.htm"),{});

  # first step: find time table
  my $table = $html->look_down(
    '_tag', 'table',
    'bgcolor', '#bfa89b',
    sub { table_header_has($_[0], "ETA") },
    sub { not table_header_has($_[0], "Starting") }
  );

  # second step: find ACTUAL time table
  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;
  return \%showtime;
}


   # # # # # # # # # # # #
   # stuff for the idler #
   # # # # # # # # # # # #

sub super_report {
  my %showtime = build_hash();
  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";
  }
}

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');
}


   # # # # # # # # # # #
   # cutie subroutines #
   # # # # # # # # # # #

sub parti {
  my @parti; push(@parti,shift);
  my @curti; push(@curti,curti());
  map { @$_ = split(/:/,$_->[0]) } (\@parti,\@curti);
  my @delta = map { $curti[$_] - $parti[$_] } (0,1,2);
  return @delta;
} # 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!