File Coverage

blib/lib/Baseball/Sabermetrics/abstract.pm

Criterion	Covered	Total	%
statement	55	78	70.5
branch	22	38	57.8
condition			n/a
subroutine	7	10	70.0
pod	0	7	0.0
total	84	133	63.1

package Baseball::Sabermetrics::abstract;
use strict;

our $AUTOLOAD;
our %formula;

#my $DEBUG = 0;

BEGIN {
    # formulas are weird, can we improve it ?
    %formula = (
	pa  =>		sub { $_->ab + $_->bb + $_->hbp + $_->sf },
	ta  =>		sub { $_->h + $_->{'2b'} + $_->{'3b'} * 2 + $_->hr * 3 },
	ba  =>		sub { $_->h / $_->ab },
	obp =>		sub { ($_->h + $_->bb + $_->hbp) / $_->pa },
	slg =>		sub { $_->tb / $_->ab },
	ops =>		sub { $_->obp + $_->slg },
	k_9 =>		sub { $_->p_so / $_->ip * 9 },
	bb_9 =>		sub { $_->p_bb / $_->ip * 9 },
	k_bb =>		sub { $_->p_so / $_->p_bb },
	isop =>		sub { $_->slg - $_->ba },
	isod =>		sub { $_->obp - $_->ba },
	rc =>		sub { $_->ab * $_->obp },

	era =>		sub { $_->er / $_->ip * 9 },
	whip =>		sub { ($_->p_bb + $_->h_allowed) / $_->ip },
	babip =>	sub { ($_->h_allowed - $_->hr_allowed) / ($_->p_pa - $_->h_allowed - $_->p_so - $_->p_bb - $_->hr_allowed) },
	g_f =>		sub { $_->go / $_->ao },

#	rf =>		sub { ($_->a + $_->po) / $_->f_inn * 9 },
	fpct =>		sub { ($_->po + $_->a) / ($_->po + $_->a + $_->e) },
    );
}

sub new
{
    my ($class, $hash) = @_;
    return bless \%$hash, $class;
}

sub AUTOLOAD : lvalue
{
    my $self = shift;
    my $type = ref($self) or die;
    my $name = $AUTOLOAD;
    $name =~ s/.*:://;
    my $ref;
    my $cachename = '!'.$name . join '!', @_;

    if ($name eq 'DESTROY') {
	# is there a better way?
	$ref = \$name;
    }
    elsif (exists $self->{$name}) {
    	$ref = \$self->{$name};
    }
    elsif (exists $self->{$cachename}) {
    	$ref = \$self->{$cachename};
    }
    elsif (exists $formula{$name}) {
#	no strict;
#	use vars qw/ $team $league /;


	my $caller = caller;
	local $_ = $self;
#	local *league = exists $self->{league} ? \$self->{league} : undef;
#	local *team = exists $self->{team} ? \$self->{team} : undef;
#	$DEBUG && print STDERR "[",__PACKAGE__,"] calculating $self->{name}'s $name, league: $league, team: $team\n";

	unless (ref $formula{$name}) {
	    $formula{$name} =~ s[(\$?)(?)("?)(\b\w(?:\w|->)*)][
		my ($d, $q, $n) = ($1, $2, $3);
		if ($q) {
		    "\"$n";
		}
		elsif ($n =~ /^\d+$/) {
		    $n;
		}
		# This is for 2b, 3b.  We assume that no formula has name with a digital initial.
		elsif ($n =~ /^\d/) {
		    "\$_->{'$n'}";
		}
		else {
		    $d ? "\$$n" : "\$_->$n"
		}
	    ]eg;
	    $formula{$name} =~ s/\$team/\$_->team/g;
	    $formula{$name} =~ s/\$league/\$_->league/g;
#	    print "## $name ##\n$formula{$name}\n";
	    $formula{$name} = eval "sub { $formula{$name} }" or die $@;
	}

	eval { $self->{$cachename} = $formula{$name}->(@_); };
    	die "$@ when eval  [ $name ] of $_->{name}\n" if $@;

	$ref = \$self->{$cachename};
    }
    else {
    	$ref = \$self->{$name};
    }

    $$ref;
}

sub print
{
    my $self = shift;
    if (grep /^all$/, @_) {
	@_ = keys %$self;
    }
    for (@_) {
	if ($_ eq 'team') {
	    print $self->team->name, "\t";
	}
	else {
	    my $val = $self->$_;
	    if ($val =~ s/(\d+\.\d\d\d)(\d)\d*/$1/) {
		$val += 0.001 if $2 >= 5;
	    }

	    print "$val\t";
	}
    }
    print "\n";
}

sub define
{
    my ($self, %funcs) = @_;
    %formula = (%formula, %funcs);
}

sub formula
{
    die "undefined formula" unless exists $formula{$_[1]};
    return $formula{$_[1]};
}

sub formula_list
{
    return keys %formula;
}

sub top
{
    my ($self, $what, $num, $func) = @_;
    if (! ref $func) {
	return (sort { $b->$func <=> $a->$func } $self->$what)[0..$num-1];
    }
    return (sort $func $self->what)[0..$num-1];
}

sub bottom
{
    my ($self, $what, $num, $func) = @_;
    if (! ref $func) {
	return (sort { $a->$func <=> $b->$func } $self->$what)[0..$num-1];
    }
    return (sort $func $self->what)[0..$num-1];
}

#sub declare
#{
#    my $self = shift;
#    $self->{$_} for (@_);
#}

1;