#!/usr/bin/perl -w # Sean Forman # Hans Van Slooten # $Date: 2017-03-08 22:45:57 -0500 (Wed, 08 Mar 2017) $ # $Author: sean $ # $Rev: 49746 $ # Copyright 2000-2016, SPORTS REFERENCE, INC. All rights reserved. use Carp; use CGI::Fast qw(:standard); use FindBin qw($Bin); use Modern::Perl '2010'; use URI::Escape; use lib "$Bin/../lib"; use SR::Cache; use SR::Defaults; use SR::Statline; use SRlocal::Constants; use SRlocal::DB; use SRlocal::Defaults; use SRlocal::Formatting; use SRlocal::Stats; use SRlocal::Teams; use SRlocal::Teams::Fetch; use SRlocal::Teams::Model; use SRlocal::Templates; chomp($0); MAIN: { my $do_test_retro = $SRlocal::Constants::TEST_RETRO_SPLITS; # Connect to the database. our $dbh = get_site_db_connection($Bin); our $memd = get_memcached_connection($Bin); our $dbh_retro = get_site_db_connection( $Bin, 'retro' ) if ($do_test_retro); our $site_params_ref = get_site_params($Bin); our $srtemplates = new SRlocal::Templates; $site_params_ref->{serve_as_cgi_script} = $TRUE; ## check the cache for the data. my $memd_key = $ENV{'REQUEST_URI'}; my $page_data = SR::Cache::get_data_from_cache( { dbh => $dbh, memd => $memd, key => $memd_key } ); # if we got data, print it. if ( is_nonempty($page_data) ) { print "CONTENT-TYPE: text/html\n\n"; $page_data =~ s|CONTENT-TYPE: *text/html||i; print $page_data; $dbh->disconnect; exit; } while ( my $q = new CGI::Fast ) { my $is_per_162 = is_empty_zero( $q->param('per162') ); # Determine if we have a batting, fielding, or pitching splits, # batting is default. my ( $split_type, $split_type_long, $team_id, $split_type_name, $table_id, $per_162_adjustment_note ); $team_id = $q->param('team') ? $q->param('team') : 'PHI'; if ( is_nonempty_print( $q->param('t') ) eq 'p' ) { $table_id = 'pitching_splits'; $split_type = 'p'; $split_type_long = 'pitch'; $split_type_name = 'Pitching'; $per_162_adjustment_note = ' (per 162 games or 650 PAs)'; } elsif ( is_nonempty_print( $q->param('t') ) eq 'f' ) { $table_id = 'fielding_splits'; $split_type = 'f'; $split_type_long = 'field'; $split_type_name = 'Fielding'; $per_162_adjustment_note = ' (per 162 games or 1,450 Innings)'; } else { $table_id = 'batting_splits'; $split_type = 'b'; $split_type_long = 'bat'; $split_type_name = 'Batting'; $per_162_adjustment_note = ' (per 162 games or 650 PAs)'; } ######## CUSTOMIZE # for the year, we use the one given or the player's last year if # none if given. If a year is less than the first retro year, we # then use the first retro year. my $year_id = $q->param('year'); $STATLINE_DEFAULTS{split_name}{span} = $TRUE; $STATLINE_DEFAULTS{split_name}{class} = 'tooltip'; if ( !$year_id ) { $year_id = $CURRENT_YEAR; } elsif ( $year_id < $FIRST_YEAR_RETRO ) { $year_id = $FIRST_YEAR_RETRO; } elsif ( $year_id > $CURRENT_YEAR ) { $year_id = $CURRENT_YEAR; } # this is needed for the js to work for guys like O'Neill. my $sth = fetch_teams( $dbh, { team_id => $team_id, year => $year_id } ); my $row = $sth->fetchrow_hashref; while ( $row && $sth->fetchrow_hashref ) { ## Should only be one, but loop to clear out the resultset just in case. } if ( !$row ) { print $q->redirect('/404.html'); next; } # this is needed for the js to work for guys like O'Neill. my $team_name = $row->{name}; my $team_link = sprintf qq{/teams/%s/%s.shtml}, $team_id, $year_id; ##################################################################################### my $page_title = $split_type_name . ' Splits'; $page_title .= $is_per_162 ? $per_162_adjustment_note : $EMPTY_STR; my $you_are_here_array = [ qq{Teams}, qq{$team_name}, qq{$page_title} ]; my $url = qq{/teams/split.cgi?t=$split_type&team=$team_id&year=$year_id}; my %model; $model{team_id} = $team_id; $model{year_id} = $year_id; $model{bio} = { data => $row }; $model{nick} = $row->{nickname}; $model{pagecontent} = []; ## Define the site header values within a hash and send the ## hash to the header script. $model{header} = { page_title => $year_id . ' ' . $team_name . ' ' . $page_title, page_url => $SRlocal::Constants::SITE_URL . $url, you_are_here => $you_are_here_array, qi_section => 'teams', use_default_keywords => $FALSE, page_description => 'Complete splits including home/road, lefty/righty, clutch situations, vs. opponent, by month, by role, and many more', }; build_team_summary_model( $dbh, $srtemplates, \%model, $split_type . 'split' ); ## Build the innernav for this franchise $model{inner_nav} = build_team_menu( $dbh, \%model, $split_type_long, $model{year_id} ); $dbh->disconnect if ($do_test_retro); $dbh = $dbh_retro if ($do_test_retro); my $incomplete_data_note = $EMPTY_STR; if ( $year_id <= 1973 ) { $incomplete_data_note = <<"END_HTML"; First column (I) indicates when a split may be incomplete due to missing play-by-play data. For all seasons after 1973, the play-by-play data is complete (summary of missing data for pre-1974). END_HTML } # We print out a note showing either a link to convert to 162 # games or a link to convert back. my $per_162_note = <<"END_HTML";

View splits adjusted to be per 162 player games

END_HTML if ($is_per_162) { $per_162_note = <<"END_HTML";

Splits are prorated to 162 player games.
View unadjusted splits

END_HTML } my $notes = <<"END_HTML";
Please note that GS refers to the number of team games played in this split (for full-game splits like Day/Night, Home/Away), and G is the number of player games that went into this split.
$per_162_note $incomplete_data_note
END_HTML ## Output the top page links and notes push @{ $model{pagecontent} }, output_content_section( { section_content => $notes, section_id => 'notes', comment_by_default => $FALSE, srtemplates => $srtemplates, title => $page_title, } ); ## Add the splits to the model _get_team_splits( $dbh, \%model, $split_type_long, $team_id, $year_id, $is_per_162 ); ## Generate the page. $page_data = $srtemplates->process( 'Pages/Team.tt2', \%model ); $page_data =~ s|CONTENT-TYPE: *text/html||i; print "CONTENT-TYPE:text/html\n\n"; print $page_data; # stuff the page into our cache. SR::Cache::put_data_in_cache( { dbh => $dbh, memd => $memd, key => $memd_key, data => $page_data, } ); } $dbh->disconnect; } ################################################################### # Usage : _show_tooltip # Purpose : returns a boolean if we should include red text for this split # Returns : a boolean # Parameters : split Name # Throws : like Johnny Damon # See Also : ################################################################### sub _show_tooltip { my ( $split_name, $type ) = @_; return $FALSE if ( $split_name eq 'vs RHP' ); return $FALSE if ( $split_name eq 'as RHP' ); return $FALSE if ( $split_name eq 'vs LHP' ); return $FALSE if ( $split_name eq 'as LHP' ); return $FALSE if ( $split_name eq 'vs RHB' ); return $FALSE if ( $split_name eq 'as RHB' ); return $FALSE if ( $split_name eq 'vs LHB' ); return $FALSE if ( $split_name eq 'as LHB' ); return $FALSE if ( $split_name eq '1st Half,GR' ); return $FALSE if ( $split_name eq '2nd Half,GR' ); return $FALSE if ( $split_name eq '1st Half,GS' ); return $FALSE if ( $split_name eq '2nd Half,GS' ); return $FALSE if ( $split_name eq 'April/Mar,GS' ); return $FALSE if ( $split_name eq 'April/Mar,GR' ); return $FALSE if ( $split_name eq 'May,GS' ); return $FALSE if ( $split_name eq 'May,GR' ); return $FALSE if ( $split_name eq 'June,GS' ); return $FALSE if ( $split_name eq 'June,GR' ); return $FALSE if ( $split_name eq 'July,GS' ); return $FALSE if ( $split_name eq 'July,GR' ); return $FALSE if ( $split_name eq 'August,GS' ); return $FALSE if ( $split_name eq 'August,GR' ); return $FALSE if ( $split_name eq 'Sept/Oct,GS' ); return $FALSE if ( $split_name eq 'Sept/Oct,GR' ); return $FALSE if ( $split_name eq 'Ages 25-' ); return $FALSE if ( $split_name eq 'Ages 26-30' ); return $FALSE if ( $split_name eq 'Ages 31-35' ); return $FALSE if ( $split_name eq 'Ages 36+' ); return $FALSE if ( $split_name eq 'as Infield' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name eq 'as Outfield' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name eq 'at Def. Pos.' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name eq 'at Off. Pos.' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name eq 'Bat1-2,non-P' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name eq 'Bat3-6,non-P' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name eq 'Bat7-9,non-P' ) && ( $type eq 'bat' ); return $FALSE if ( $split_name =~ /as .HB.[A-Z][A-Z][A-Z]/ ); return $FALSE if ( $split_name =~ /as .HP.[A-Z][A-Z][A-Z]/ ); return $FALSE if ( $split_name =~ /as .HP@/ ); return $FALSE if ( $split_name =~ /as .HB@/ ); return $FALSE if ( $split_name =~ /vs .HB, from gl/ ); return $FALSE if ( $split_name =~ /vs Unk/ ); return $FALSE if ( $split_name =~ /as Unk/ ); return $TRUE; } ################################################################### # Usage : _get_team_splits # Purpose : returns tables of splits for a particular team or league # Returns : a large set of html tables. # Parameters : dbh, team_id, year_id (YYYY or Career) # Throws : like Johnny Damon # See Also : # Comments : We are going to change the bsplit_bit calls here to be # tooltips like the rest of the site rather than in place divs. This # is more consistent with the rest of the site and also should make it # a bit easier to do here. ################################################################### sub _get_team_splits { my ( $dbh, $model, $type, $team_id, $year_id, $is_per_162 ) = @_; my $return = $EMPTY_STR; my ( $query, @stats, @stats_extra ); if ( $type eq 'bat' ) { $query = <<"..."; SELECT group_id, subgroup_id, split_name, $defn_of_statlines{batting_simple}{select}, GS, ROE, "$year_id" AS year_id, tOPS as onbase_plus_slugging_vs_total, sOPS as onbase_plus_slugging_vs_lg, ROUND($SRlocal::Stats::batting_avg_bip,3) AS batting_avg_bip, IF(incomplete=1,'I','') AS incomplete_split FROM tbsplit AS split_table WHERE batting_team_id=? and year_game=? ORDER BY spo ASC ... $query =~ s/(AB + IFNULL(BB,0) + IFNULL(HBP,0) + IFNULL(SF,0) + IFNULL(SH,0))/PA/; @stats = ( qw(incomplete_split split_name), @{ $defn_of_statlines{batting_simple}{list} }, qw(batting_avg_bip onbase_plus_slugging_vs_total onbase_plus_slugging_vs_lg) ); @stats_extra = (); delete_stat_from_statline( 'onbase_plus_slugging_vs_lg', \@stats ) if ( $year_id eq 'Career' ); add_stat_to_statline_after_stat( 'GS', \@stats, 'G' ); add_stat_to_statline_after_stat( 'ROE', \@stats, 'IBB' ); } elsif ( $type eq 'pitch' ) { # Set up the queries for a single year or a career. $query = <<"END_SQL"; SELECT group_id, subgroup_id, split_name, ROE, WP, ER, IPouts, $defn_of_statlines{pitching_splits}{select}, $defn_of_statlines{batting_simple}{select}, "$year_id" AS year_id, tOPS as onbase_plus_slugging_vs_total, sOPS as onbase_plus_slugging_vs_lg, ROUND($SRlocal::Stats::batting_avg_bip,3) AS batting_avg_bip, IF(incomplete=1,'I','') AS incomplete_split FROM tpsplit AS split_table WHERE pitching_team_id=? AND year_game=? ORDER BY spo ASC END_SQL $query =~ s/SV/S AS SV/; $query =~ s/BFP/BF/; $query =~ s/ RBI/ R/; $query =~ s/ WP/ NULL AS WP/; $query =~ s/(AB + IFNULL(BB,0) + IFNULL(HBP,0) + IFNULL(SF,0) + IFNULL(SH,0))/BF/; $query =~ s/PA/BF/; @stats_extra = ( qw(incomplete_split split_name), @{ $defn_of_statlines{pitching_splits}{list} }, ); @stats = ( qw(incomplete_split split_name), @{ $defn_of_statlines{batting_simple}{list} }, qw(batting_avg_bip onbase_plus_slugging_vs_total onbase_plus_slugging_vs_lg) ); add_stat_to_statline_after_stat( 'ROE', \@stats, 'IBB' ); delete_stat_from_statline( 'RBI', \@stats ); delete_stat_from_statline( 'onbase_plus_slugging_vs_lg', \@stats ) if ( $year_id eq 'Career' ); add_stat_to_statline_after_stat( 'strikeouts_per_base_on_balls', \@stats, 'SO' ); } else { return $EMPTY_STR; } # remove teh incomplete column for pre1974 seasons if ( $year_id > 1973 ) { delete_stat_from_statline( 'incomplete_split', \@stats ); delete_stat_from_statline( 'incomplete_split', \@stats_extra ); } # We have to get the joint stats here, so we can do the adjusted # to 162 games output. my %stats_joint; foreach my $stat (@stats) { $stats_joint{$stat}++; } foreach my $stat (@stats_extra) { $stats_joint{$stat}++; } my @stats_joint = keys %stats_joint; my $sth = db_prepare_and_execute( $dbh, $query, $team_id, $year_id ); my $line_count = 0; my $last_subgroup_id = $EMPTY_STR; my $have_as_dh = $FALSE; my $have_close_and_late = $FALSE; my $is_per_162_type = $EMPTY_STR; my $return_extra = $EMPTY_STR; my $last_gf = $EMPTY_STR; my @stats_default = @stats; my ( %table_defn, %table_defn_extra ); my $subgroup_count = 0; while ( my $tmp = $sth->fetchrow_hashref ) { @stats = @stats_default; if (( $type eq 'pitch' ) && ( ( $tmp->{group_id} =~ m/(catch)/ ) || ( $tmp->{subgroup_id} eq 'innng' ) ) ) { add_stat_to_statline_after_stat( 'earned_run_avg', \@stats, 'G' ); add_stat_to_statline_after_stat( 'ER', \@stats, 'G' ); add_stat_to_statline_after_stat( 'IP', \@stats, 'G' ); $tmp->{IP} = sprintf( qq{%5.1f}, $tmp->{IPouts} / 3 ) if ( is_nonempty( $tmp->{IPouts} ) ); $tmp->{earned_run_avg} = sprintf qq{%5.2f}, 27 * $tmp->{ER} / $tmp->{IPouts} if ( is_empty_zero( $tmp->{IPouts} ) ); } # for the per 162, we need to adjust the columns, so that they # properly handle the true G or PA value shown. if ($is_per_162) { $is_per_162_type = is_empty( $tmp->{GS} ) ? 'per_650_PA' : 'per_162_G'; delete_stat_from_statline( 'PA_actual', \@stats ); delete_stat_from_statline( 'G_actual', \@stats ); add_stat_to_statline_after_stat( 'PA_actual', \@stats, 'PA' ) if ( $is_per_162_type eq 'per_650_PA' ); add_stat_to_statline_after_stat( 'G_actual', \@stats, 'G' ) if ( $is_per_162_type eq 'per_162_G' ); } # We have changed subgroups which means we need to close the # last table and open up the next one. if ( $tmp->{subgroup_id} ne $last_subgroup_id ) { $subgroup_count++; if ( $line_count > 0 ) { $table_defn{footer} = SRlocal::Constants::_get_split_subgroup_note_after( $last_subgroup_id, { have_as_dh => $have_as_dh, have_close_and_late => $have_close_and_late, is_running_team => $FALSE } ); # Close the last table, but only if we've seen lines of splits. if ( $line_count > 0 ) { $return .= generate_statline_footer_wrap( \%table_defn ); push @{ $model->{pagecontent} }, $return; } if ( @stats_extra && _nemp($last_gf) ) { $return_extra .= generate_statline_footer_wrap( \%table_defn_extra ); push @{ $model->{pagecontent} }, $return_extra; } } # For the pitchers, we have to split their splits into two # separate outputs: one batting vs. and one regular # pitching stats. $return = $EMPTY_STR; $return_extra = $EMPTY_STR; my $table_id = $tmp->{subgroup_id}; my $table_title = is_nonempty( $SRlocal::Constants::SPLIT_SUBGROUP_NAME{ $tmp->{subgroup_id} } ) ? $SRlocal::Constants::SPLIT_SUBGROUP_NAME{ $tmp->{subgroup_id} } : $tmp->{subgroup_id}; # Use Statline to start the table and get the table header. my @other_links = (); push( @other_links, $SRlocal::Constants::SPLIT_SUBGROUP_NOTE{ $tmp->{subgroup_id} } ) if is_nonempty( $SRlocal::Constants::SPLIT_SUBGROUP_NOTE{ $tmp->{subgroup_id} } ); %table_defn = ( table_id => $table_id, title => $table_title, caption => $table_title, table_cols_to_freeze => 1, comment_by_default => $subgroup_count > 2, hide_long => $FALSE, section_heading_text => join( '
  • ', @other_links ), table_class => '', ); $return .= generate_statline_header_wrap( \%table_defn ); $return .= generate_statline_header( \@stats, { suppress_all_ids_as_headers => $TRUE } ); if (@stats_extra) { %table_defn_extra = ( table_id => $table_id . '_extra', title => $table_title . ' -- Game-Level', caption => $table_title . ' -- Game-Level', table_cols_to_freeze => 1, comment_by_default => $subgroup_count > 2, hide_long => $FALSE, section_heading_text => join( '
  • ', @other_links ), table_class => '', ); $return_extra .= generate_statline_header_wrap( \%table_defn_extra ); $return_extra .= generate_statline_header( \@stats_extra, { suppress_all_ids_as_headers => $TRUE } ); } $have_as_dh = $FALSE; $have_close_and_late = $FALSE; } # We store these because we may need to print out an explanation later. $have_as_dh = $TRUE if ( $tmp->{split_name} =~ /as DH/ ); $have_close_and_late = $TRUE if ( $tmp->{split_name} =~ /Late.*Close/ ); # If this is a per 162 game split, we need to modify all of # the columns. if ($is_per_162) { # our adjustment_factor depends on whether GS is null or # not. If gs is null we use 650 PA's if not we use 162 # games. my $adjustment_factor = $is_per_162_type eq 'per_162_G' && ( $tmp->{GS} > 0 ) ? sprintf( "%.4f", 162.0 / $tmp->{GS} ) : $is_per_162_type eq 'per_650_PA' && ( $tmp->{PA} > 0 ) ? sprintf( "%.4f", 650.0 / $tmp->{PA} ) : 1.0; if ( $type eq 'pitch' ) { # For pitching we use our 68/(G+GS) factor. $adjustment_factor = $is_per_162_type eq 'per_162_G' && ( $tmp->{GS} + $tmp->{GS} > 0 ) ? sprintf( "%.4f", 24.0 / ( $tmp->{GS} ) ) : $is_per_162_type eq 'per_650_PA' && ( $tmp->{PA} > 0 ) ? sprintf( "%.4f", 650.0 / $tmp->{PA} ) : 1.0; } $tmp->{PA_actual} = $tmp->{PA}; $tmp->{G_actual} = $tmp->{G}; foreach my $stat (@stats_joint) { # If this isn't a ratio stat and if it has only # numbers, we when multiply it by the adjustment # factor. if ( ( !$STATLINE_DEFAULTS{$stat}{ratio} ) && is_nonempty( $tmp->{$stat} ) && ( $tmp->{$stat} =~ /^[0-9\.]+$/ ) && ( $stat ne 'PA_actual' ) && ( $stat ne 'G_actual' ) && ( $stat ne 'year_ID' ) && ( $stat ne 'split_name' ) ) { $tmp->{$stat} = sprintf( qq{%d}, $tmp->{$stat} * $adjustment_factor ); } } } $tmp->{split_name_original} = $tmp->{split_name}; if ( !_show_tooltip( $tmp->{split_name}, $type ) ) { $STATLINE_DEFAULTS{split_name}{class} = ''; } else { $tmp->{split_name_endpoint} = sprintf qq{/play-index/split_stats_team.cgi?full=0¶ms=%s}, uri_escape( $tmp->{subgroup_id} . '|' . $tmp->{split_name_original} . '|' . $team_id . '|' . $year_id . '|' . $type . '|AB|' . $is_per_162_type ); } # We divide the GS by 9 to get the team's actual games played # if this is a batting split. # We divide the GS by 9 to get the team's actual games played # if this is a batting split. if ( ( $type eq 'bat' ) && ( is_nonempty( $tmp->{GS} ) ) && ( $tmp->{split_name_original} !~ /^Bat/ ) && ( $tmp->{split_name_original} !~ /^Ages/ ) ) { $tmp->{GS} = sprintf "%d", $tmp->{GS} / 9; } $tmp->{split_name} = SRlocal::Constants::_clean_split_name( $dbh, $tmp, $year_id ); $return .= generate_statline( \@stats, $tmp ); # check to see if we want to show this tooltip if ( !_show_tooltip( $tmp->{split_name}, $type ) ) { $STATLINE_DEFAULTS{split_name}{class} = ''; } else { $tmp->{split_name_endpoint} = sprintf qq{/play-index/split_stats_team.cgi?full=0¶ms=%s}, uri_escape( $tmp->{subgroup_id} . '|' . $tmp->{split_name_original} . '|' . $team_id . '|' . $year_id . '|' . $type . '|IP|' . $is_per_162_type ); $STATLINE_DEFAULTS{split_name}{class} = 'tooltip'; } $return_extra .= generate_statline( \@stats_extra, $tmp ); $line_count++; $last_subgroup_id = $tmp->{subgroup_id}; $last_gf = $tmp->{GF}; } $return .= $return_extra if ( @stats_extra && ( is_nonempty($last_gf) ) ); if ( $line_count > 0 ) { $return .= generate_statline_footer_wrap( \%table_defn ); } $sth->finish; return scalar $return; }