Great idea.
Here's a program I wrote a few years back.
The first time you run it, you get a table with the
current statistics for all your players.
After that, you run it daily and it shows you
how the stats have changed since the previous run---
this effectively shows how the players performed on the previous day.
It also maintains a historical archive of each player's
records and a daily summary for the entire team.
I used to run this daily as a cron job, so every morning
I would get a report about how my players were doing.
#!/usr/bin/perl
use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
sub fixup_stats (\%);
$ROOT = 'http://www.usatoday.com/sports/baseball/';
$HOME = '/data/baseball/plover-1998';
# $HOME = '/data/baseball/plover-1998/test';
%WIDTH =
(BB => 3, SG => 3, DB => 2, TP => 2, HR => 2, TB => 3,
OB => 3, AB => 3, PA => 3,
AVG => 4, OBA => 4, SLG => 4, SB => 2, CS => 2, SBG => 3,
R => 3, RBI => 3,
IP => 5, ER => 3, ERA => 5, W => 2, L => 2, S => 2, WLS => 3,
H => 3, BB => 3, BRA => 5, K => 3, BB => 3, KBB => 5,
);
%LOCAL_STATS =
(BAT => [qw(BB SG DB TP HR TB OB AB PA AVG OBA SLG SB CS SBG R RBI)]
+,
PIT => [qw(IP ER ERA W L S WLS H BB BRA K KBB)],
);
%REMOTE_STATS =
(BAT => [qw(AVG SLG OBA G AB R H TB DB TP HR RBI BB SO SB CS E)],
PIT => [qw(W L ERA AVG G GS CG GF SH S IP H R ER HR BB K)],
);
%P_TYPE =
( '1B' => BAT, C => BAT, '2B' => BAT, '3B' => BAT,
SS =>BAT, CF => BAT, OF => BAT, MI => BAT, IF => BAT,
SP => PIT, RP => PIT,
);
%DS = ('C' => 0,
'1B' => 1, '2B' => 2, 'SS' => 3, '3B' => 4,
'MI' => 3.5, 'IF' => 4.5,
'CF' => 5, 'OF' => 6,
);
%T_URL = (
BAL => A1, BOS => A2, NYY => A10, TBR => A15, TOR => A14,
CWS => A4, CLE => A5, DET => A6, KCR => A7, MIN => A9,
ANA => A3, OAK => A11, SEA => A12, TEX => A13, ATL => N1,
FLA => N5, MON => N8, NYM => N9, PHI => N10, CHC => N3,
CIN => N2, HOU => N6, MIL => N16, PIT => N11, STL => N14,
ARI => N15, COL => N4, LAD => N7, SDP => N12, SFG => N13,
);
%P_INFO =
(
Steinbach => [C, MIN, ACT],
McGwire => ['1B', STL, ACT],
Graffanino => ['2B', ATL, RES],
Caminiti => ['3B', SDP, ACT],
Veras => ['2B', SDP, ACT],
Anderson => [CF, BAL, ACT],
'A. Jones' => [CF, ATL, ACT],
Salmon => [OF, ANA, ACT],
Loretta => [SS, MIL, ACT],
Hammonds => [CF, BAL, RES],
Konerko => ['3B', CIN, RES],
Servais => [C, CHC, ACT],
Santiago => [C, TOR, RES],
Buhner => [OF, SEA, ACT],
Rivera => [OF, SDP, RES],
Young => ['1B', PIT, ACT],
Strange => ['3B', PIT, RES],
Spiers => ['3B', HOU, RES],
Perez => ['1B', CIN, RES],
Aurilia => ['SS', SFG, ACT], # Signed in July draft
Appier => [SP, KCR, RES],
Glavine => [SP, ATL, ACT],
Rueter => [SP, SFG, ACT],
Smoltz => [SP, ATL, ACT],
Moyer => [SP, SEA, ACT],
Lima => [SP, HOU, ACT], # Signed in May draft
Jones => [RP, DET, ACT],
Wagner => [RP, HOU, ACT],
Burkett => [SP, TEX, RES],
Blair => [SP, ARI, RES],
Taylor => [RP, OAK, RES],
);
################################################################
foreach $player (keys %P_INFO) {
my ($pos, $team, $stat) = @{$P_INFO{$player}};
push @{$players{$team}}, $player;
}
{
my ($sec, $min, $hour, $d, $m, $y) = localtime;
$DATE = sprintf("%04d%02d%02d", $y+1900, $m+1, $d);
$DAILY = "DAILY-$DATE";
$GAME = "GAME-$DATE";
open DP, "> $HOME/$DAILY-P"
or die "Couldn't open daily file $HOME/$DAILY-P: $!; aborting";
open DB, "> $HOME/$DAILY-B"
or die "Couldn't open daily file $HOME/$DAILY-B: $!; aborting";
open GP, "> $HOME/$GAME-P"
or die "Couldn't open game file $HOME/$GAME-P: $!; aborting";
open GB, "> $HOME/$GAME-B"
or die "Couldn't open game file $HOME/$GAME-B: $!; aborting";
}
my @team_queue = keys %players;
while (@team_queue) {
my $team = shift @team_queue;
next if $team eq XXX; # Players not on any team
my $url = team_url($team);
my $request = HTTP::Request->new(GET => $url);
my $response = $ua->request($request);
unless ($response->is_success) {
my $error = $response->status_line;
print "$team($url): $error\n";
push @team_queue, $team;
next;
}
my @lines = split /\r?\n/, $response->content;
foreach $player (@{$players{$team}}) {
my ($ppos, $pteam, $pstat) = @{$P_INFO{$player}};
my $ptype = $P_TYPE{$ppos};
my @loi = grep /^$player/, @lines;
if (@loi == 0) {
warn "Couldn't find information for player $player on team $team
+.\n";
next;
} elsif (@loi > 1) {
warn "Found multiple information for player $player on team $tea
+m.\n";
next;
}
my %STATS = get_stats($player, @loi);
fixup_stats(%STATS);
my $pn = substr($player . " ", 0, 15);
my $fn = "$HOME/:$player";
$fn =~ tr/ //d;
my $statline = put_stats($player, %STATS);
my $yesterday = get_last_line($fn);
unless (open P, ">> $fn") {
warn "Couldn't append to file `$fn': $!; skipping $player.\n";
next;
}
print P $DATE, " ", $statline, "\n";
my (%yesterday, $k);
@yesterday{'DATE', @{$LOCAL_STATS{$ptype}}} = split /\s+/, $yester
+day;
foreach $k (keys %STATS) {
next unless exists $yesterday{$k};
$yesterday{$k} = int(($STATS{$k} - $yesterday{$k})*1000)/1000;
$TOTAL{$k} += $yesterday;
}
my $game_statline = put_stats($player, %yesterday);
$statline{$player} = $statline;
$game_statline{$player} = $game_statline;
print STDERR "Done with player $player.\n";
}
}
close P;
@PLAYERS = keys %P_INFO;
@PITCHERS = grep {$P_TYPE{$P_INFO{$_}[0]} eq PIT} @PLAYERS;
@BATTERS = grep {$P_TYPE{$P_INFO{$_}[0]} eq BAT} @PLAYERS;
if (open Q, "< $HOME/BHEADER-D") {
while (<Q>) {
print DB;
print GB;
}
close Q;
} else {
warn "Couldn't open header file BHEADER-D: $!";
}
$prevstat = 'ACT';
foreach $player (sort {$P_INFO{$a}[2] cmp $P_INFO{$b}[2]
||
$DS{$P_INFO{$a}[0]} <=> $DS{$P_INFO{$b}[0]}
||
$a cmp $b
}
@BATTERS) {
next if $P_INFO{$player}[1] eq XXX;
if ($P_INFO{$player}[2] eq RES && $prevstat eq ACT) {
print DB "\n";
$prevstat = RES;
}
my $pn = substr("$player/$P_INFO{$player}[0] ", 0, 13);
print DB $pn, $statline{$player}, "\n";
print GB $pn, $game_statline{$player}, "\n";
}
print DB "\n\n";
close DB;
print GB "\n\n";
close GB;
if (open Q, "< $HOME/PHEADER-D") {
while (<Q>) {
print DP;
print GP;
}
close Q;
} else {
warn "Couldn't open header file PHEADER-D: $!";
}
$prevstat = 'ACT';
foreach $player (sort {$P_INFO{$a}[2] cmp $P_INFO{$b}[2]
||
$P_INFO{$b}[0] cmp $P_INFO{$a}[0]
||
$a cmp $b
}
@PITCHERS) {
next if $P_INFO{$player}[1] eq XXX;
if ($P_INFO{$player}[2] eq RES && $prevstat eq ACT) {
print DP "\n";
$prevstat = RES;
}
my $pn = substr("$player/$P_INFO{$player}[0] ", 0, 13);
print DP $pn, $statline{$player}, "\n";
print GP $pn, $game_statline{$player}, "\n";
}
close DP;
close GP;
system qq{cat $HOME/$GAME-? | Mail -s 'Philadelphia Plovers Report' mj
+d};
################################################################
sub team_url {
my $team = shift;
my ($l, $n) = ($T_URL{$team} =~ /^([AN])(\d+)$/);
die "Couldn't compute url for team $team; aborting"
unless defined $l;
$n = sprintf("%02d", $n);
$l = lc $l;
$ROOT . "sb$l/sb$ {l}98$n.htm";
}
sub get_stats {
my $player = shift;
my $line = shift;
$line =~ s/^\Q$player\E\s*//
or warn "Line of interest:\n\t$line\ndoes not begin with player's
+name `$player'.\n";
my @f = split /[\s-]+/, $line;
# shift @f while $f[0] eq ''; # Discard leading null fields
my $bp = $P_TYPE{$P_INFO{$player}[0]};
my %stats;
@stats{@{$REMOTE_STATS{$bp}}} = @f;
%stats;
}
sub put_stats {
my $player = shift;
my %stats = @_;
my $bp = $P_TYPE{$P_INFO{$player}[0]};
my $statline = '';
foreach $stat (@{$LOCAL_STATS{$bp}}) {
my $s = fill($stats{$stat}, $WIDTH{$stat});
if (! defined $s) {
print STDERR "($stat)\n";
next;
}
$statline .= $s . ' ';
}
chop $statline;
$statline;
}
sub fill {
my $d = shift;
my $w = shift;
$d =~ s/^0\././;
$d =~ s/^-0\./-/;
$d =~ s/0{5,}.*$//;
if (length($d) > $w) {
print STDERR "Couldn't fill `$d' to width $w.";
return undef;
}
$d = (' ' x $w) . $d;
substr($d, -$w);
}
sub fixup_stats (\%) {
my $s = shift;
# Innings pitched 12.2 => 12.7
if (exists $s->{IP}) {
my ($i, $f) = split /\./, $s->{IP};
$s->{IP} = sprintf("%2.1f", $i + $f/3);
}
if (exists $s->{ERA}) {
$s->{ERA} = sprintf("%.2f", int($s->{ERA} * 100)/100);
}
foreach $stat (qw(AVG OBA SLG)) {
if (exists $s->{$stat}) {
$s->{$stat} = sprintf(".%03d", int($s->{$stat} * 1000));
}
}
if (exists $s->{W}) { # Pitching
$s->{WLS} = $s->{W} * 2 + $s->{S} - $s->{L};
eval {$s->{BRA} = sprintf("%4.2f", 9 * ($s->{BB} + $s->{H}) / $s->
+{IP})};
$s->{BRA} = '----' if $@;
eval {$s->{KBB} = sprintf("%4.2f", $s->{K} / $s->{BB})};
$s->{KBB} = '---' if $@;
} else { # Batting
$s->{SG} = $s->{H} - $s->{DB} - $s->{TP} - $s->{HR};
$s->{OB} = $s->{H} + $s->{BB};
$s->{PA} = $s->{AB} + $s->{BB};
$s->{SBG} = $s->{SB} - $s->{CS};
}
}
sub get_last_line {
my $file = shift;
my $linelen = shift || 80;
open Q, "< $file" || die "Couldn't open file `$file': $!; aborting";
seek Q, -$linelen, 2;
my $prev = undef;
while (<Q>) {
$prev = $_;
}
return $prev;
}
|