#!/usr/bin/perl -w # AUTHORS # Sean Forman # Adam Wodon # Hans Van Slooten # $Date: 2017-04-05 17:01:54 -0400 (Wed, 05 Apr 2017) $ # $Author: hvs $ # $Rev: 50641 $ # $HeadURL: http://svn.sports-reference.com/svn/br_repos/br/trunk/boxes/index.fcgi $ # Copyright 2000-2017, SPORTS REFERENCE, LLC All rights reserved. use Carp; use CGI::Fast qw(:standard); use Time::Piece; use Date::Pcalc qw( Day_of_Week Day_of_Week_to_Text); use Date::Manip; use FindBin qw($Bin); use Modern::Perl '2010'; use lib "$Bin/../lib"; use SR::Cache; use SR::Defaults; use SR::Statline; use SRlocal::Allstar; use SRlocal::Boxes; use SRlocal::Constants; use SRlocal::DB; use SRlocal::Stats; chomp($0); #### [] Starting: "$Bin/$0 " . join(' ',@ARGV) MAIN: { # Get the db handle and a reference to a hash of site params our $memd = get_memcached_connection($Bin); our $dbh = get_site_db_connection($Bin); our $site_params_ref = get_site_params($Bin); our $srtemplates = new SRlocal::Templates; our $date = localtime->ymd; LOOPER: while ( my $cgi = new CGI::Fast ) { # check the cache for the data. my $memd_key = $ENV{'REQUEST_URI'}; my $page_data = SR::Cache::get_data_from_cache( { memd => $memd, key => $memd_key } ); # if we got data, print it. if ( is_nonempty($page_data) ) { print "SR-HIT-MEMD-KEY: $memd_key\n"; print "CONTENT-TYPE: text/html; charset=UTF-8\n\n"; $page_data =~ s|CONTENT-TYPE: *text/html.*||i; print $page_data; next LOOPER; } else { print "SR-MISS-MEMD-KEY: $memd_key\n"; } # Get the script parameters. my ( $month, $day, $year ); if ( $cgi->param('today') ) { $year = substr( $date, 0, 4 ); $month = substr( $date, 5, 2 ); $day = substr( $date, 8, 2 ); } elsif ( $cgi->param('date') ) { $year = substr( $cgi->param('date'), 0, 4 ); $month = substr( $cgi->param('date'), 5, 2 ); $day = substr( $cgi->param('date'), 8, 2 ); } else { $month = $cgi->param('month'); $day = $cgi->param('day'); $year = $cgi->param('year'); } # If we're given bad parameters then remove so that the page defaults to current day my $dt = ParseDate("$month/$day/$year") if ( $month && $day && $year ); if ( ( !defined $dt ) || $year < $STATS_YEAR_MIN || $year > $STATS_YEAR_MAX ) { $year = 0; } # If no month, day, or year is given then default to the date of last games played my $date_was_passed = $TRUE; if ( !$month || !$day || !$year ) { $date_was_passed = $FALSE; $date = SRlocal::Boxes::get_last_date_games_played($dbh); $year = substr( $date, 0, 4 ); $month = substr( $date, 5, 2 ); $day = substr( $date, 8, 2 ); } # Build the game date. my $date_game = sprintf "%04d-%02d-%02d", $year, $month, $day; my $day_of_week = Day_of_Week_to_Text( Day_of_Week( $year, $month, $day ) ); my %model = (); # Set the page title. my $date_name = sprintf( "%s, %s %s, %s", $day_of_week, $MONTH_NAMES{$month}, $day, $year ); my $page_title = $date_was_passed ? sprintf("MLB Scores, Standings, Box Scores for $date_name") : "MLB Scores, Standings, Box Scores"; my @yah = (q[Box Scores]); push @yah, qq[$page_title] if $date_was_passed; # Set up the "You Are Here" line. my $you_are_here = generate_you_are_here( \@yah, '/boxes/' ); my $canonical_url = $date_was_passed ? "$SITE_URL/boxes/$year/$month/$day/" : "$SITE_URL/boxes/"; # Define the site header values within a hash and send the hash to the # header script. $model{header} = { page_title => $page_title, page_label => qq{MLB Scores and Standings} . ( $date_was_passed ? qq{ $date_name} : $EMPTY_STR ), page_url => $canonical_url, page_description => ( sprintf 'MLB scoreboard/standings for %s and historical box scores/standings on Baseball-Reference.com.', $date_was_passed ? "$MONTH_NAMES{$month} $day, $year" : "today" ), you_are_here => $you_are_here, qi_section => "boxes", }; # Print the date form. push( @{ $model{pagecontent} }, _get_date_form( $year, $month, $day ) ); # Print the scores for this date. my @summary_data = SRlocal::Boxes::get_scoreboard_data( $dbh, $date_game, { suffix => ( $site_params_ref->{site_type} eq 'dev' || $site_params_ref->{site_type} eq 'build' ? '_year' : undef ) } ); if (@summary_data) { push( @{ $model{pagecontent} }, $srtemplates->process( 'Partials/Games/GameSummaries.tt2', { game_summaries => [@summary_data], } ) ); } else { push( @{ $model{pagecontent} }, qq{

No Games Were or Have Yet Been Played on This Date

} ); } ##################################################################################### # Print out the standings upto and including this date. my %qn_settings = ( switcher => $TRUE, items => [ { sr_preset => { show => '#standings-upto', hide => '.standings-dated' }, label => 'Up To This Date', current => $TRUE }, { sr_preset => { show => '#standings-after', hide => '.standings-dated' }, label => 'After This Date' }, ], ); push( @{ $model{pagecontent} }, $srtemplates->process( 'Partials/ContentSection/QuickNav.tt2', \%qn_settings ) ); my $standings_html; foreach my $type ( 'upto', 'after' ) { $standings_html .= sprintf( '
', $type, $type eq 'after' ? ' hidden' : $EMPTY_STR ); $standings_html .= sprintf( '

Standings %s this Date

', $type eq 'upto' ? "Up to and Including" : "For Games Played After" ); $standings_html .= '
'; # We are printing out two tables in the era of divisional play. $standings_html .= '
' if ( $year > 1968 ); # Do the breakouts by division. $standings_html .= _get_standings_tables( $dbh, $type, $TRUE, $year, $month, $day ); $standings_html .= '
' if ( $year > 1968 ); # We then print out the overall standings as well. if ( $year > 1968 ) { $standings_html .= '
'; $standings_html .= _get_standings_tables( $dbh, $type, $FALSE, $year, $month, $day ); $standings_html .= "
"; } $standings_html .= '
'; } push( @{ $model{pagecontent} }, $standings_html ); ##################################################################################### # Print the CGI header. print $cgi->header( -charset => 'utf-8' ); my $output = $srtemplates->process( 'Pages/General.tt2', \%model ); print $output; # stuff the page into our cache. SR::Cache::put_data_in_cache( { dbh => $dbh, memd => $memd, key => $memd_key, data => $output, } ); } # Disconnect from the database. $dbh->disconnect; } ############################################################################## # Usage : _get_date_form( $year, $month, $day) # Purpose : Output links to the next/previous dates, plus a form to select # any date. # Returns : A scalar that contains the text. # Parameters : The month and the day. # Throws : no exceptions # Comments : none # See Also : n/a ############################################################################## sub _get_date_form { my ( $year, $month, $day ) = @_; my $srtemplates = new SRlocal::Templates; # Initialize the output variable. my $output = $EMPTY_STR; # Get the number of days in this month. my $days_in_month = Date::Pcalc::Days_in_Month( $year, $month ); my $prev_month = $day > 1 ? $month : $month > 1 ? $month - 1 : 12; my $prev_day = $day > 1 ? $day - 1 : Date::Pcalc::Days_in_Month( $year, $prev_month ); my $prev_year = $month == 1 && $day == 1 ? $year - 1 : $year; my $next_month = $day < $days_in_month ? $month : $month < 12 ? $month + 1 : 1; my $next_day = $day < $days_in_month ? $day + 1 : 1; my $next_year = $month == 12 && $day == 31 ? $year + 1 : $year; my %prevnav = ( prev => { link => "/boxes/?year=$prev_year&month=$prev_month&day=$prev_day", label => convert_sql_date_to_full_date( join( '-', $prev_year, $prev_month, $prev_day ), { type => 'mmm dd, yyyy' } ), }, next => { link => "/boxes/?year=$next_year&month=$next_month&day=$next_day", label => convert_sql_date_to_full_date( join( '-', $next_year, $next_month, $next_day ), { type => 'mmm dd, yyyy' } ), }, current => { label => convert_sql_date_to_full_date( join( '-', $year, $month, $day ), { type => 'mmm dd, yyyy' } ), }, ); # $output .= $srtemplates->process( 'Partials/ContentSection/PrevNext.tt2', \%formsettings ); $output .= output_prevnext_nav( \%prevnav ); my @monthchoices; foreach ( 1 .. 12 ) { push( @monthchoices, { val => $_, label => $MONTH_NAMES{$_} } ); } my %formsettings = ( method => 'get', action => '/boxes/', fields => [ { group => $TRUE, linear => $TRUE, subfields => [ { type => 'dropdown', name => 'month', val => $month + 0, # ensures "03" is "3" for these purposes choices => \@monthchoices, }, { type => 'dropdown', name => 'day', val => int($day), start => 1, end => 31, no_chosen => $TRUE, }, { type => 'dropdown', name => 'year', val => ( $year < $CURRENT_YEAR ? $year : $CURRENT_YEAR ), start => 1871, end => $CURRENT_YEAR, no_chosen => $TRUE, }, { type => 'submit', val => 'Find Games', }, ], }, ], ); $output .= $srtemplates->process( 'Partials/Forms/Form.tt2', \%formsettings ); my @years = map { '/leagues/MLB/' . $_ . '-schedule.shtml:' . $_ } reverse( 1871 .. $CURRENT_YEAR ); $output .= SR::Defaults::output_goto_nav( { id => 'year_schedule', srtemplates => $srtemplates, default_hide => $TRUE, form_description => '', fieldset_label => '', not_linear => $TRUE, select_array => [ { select_ref => \@years, desc_option => 'or Go to a Season Schedule', no_chosen => $TRUE, name => 'year', }, ], } ); return scalar $output; } ################################################################### # Usage : _get_standings_tables # Purpose : provides the standings for various types # Returns : a sql query # Parameters : direction (upto, after), divisions ($TRUE,$FALSE) # Throws : # See Also : # Comments : ################################################################### sub _get_standings_tables { # $direction is upto or after. # $divisions is whether to split by league or by division. my ( $dbh, $direction, $do_separate_divisions, $year, $month, $day ) = @_; # Build the where clause for the various directions. Print out # full standings by default. my $where = '1 > 0'; if ( $direction eq 'upto' ) { $where = "tgl_stats.year_game=$year AND ((month(date_game) < $month) OR (month(date_game) = $month AND dayofmonth(date_game) <= $day))"; } elsif ( $direction eq 'after' ) { $where = "tgl_stats.year_game=$year AND ((month(date_game) > $month) OR (month(date_game) = $month AND dayofmonth(date_game) > $day))"; } # For divisional play we have a couple of different outputs to make. my $group = 'majors_team.team_ID, majors_team.lg_ID'; my $order = 'lg_ID ASC, games_over_500 DESC, win_loss_perc desc, Ws DESC'; if ($do_separate_divisions) { $group = 'majors_team.team_ID, majors_team.lg_ID'; $order = 'lg_ID ASC, DIVvalue ASC, games_over_500 DESC, win_loss_perc DESC, Ws desc'; } my $query = <<"END_SQL"; SELECT majors_team.team_ID, CONCAT('/teams/',majors_team.team_ID,"/$year.shtml") AS team_ID_link, majors_team.lg_ID, DIVISION, FIELD(DIVISION,'E','C','W') as DIVvalue, SUM(IFNULL(tgl_stats.RS,0)) as RS, SUM(IFNULL(tgl_stats.RA,0)) as RA, SUM(IFNULL(tgl_stats.W,0)) as W, SUM(IFNULL(tgl_stats.L,0)) as L, trim( leading '0' from round(sum(IFNULL(tgl_stats.W,0))/greatest(1, sum(IFNULL(tgl_stats.W,0)) + sum(IFNULL(tgl_stats.L,0))),3)) as win_loss_perc, SUM(IFNULL(tgl_stats.W,0))-SUM(IFNULL(tgl_stats.L,0)) as games_over_500 FROM majors_team LEFT JOIN tgl_stats ON majors_team.team_ID=tgl_stats.team_id AND majors_team.year_ID=tgl_stats.year_game AND $where WHERE majors_team.year_ID=$year GROUP BY $group ORDER BY $order END_SQL my @stats = @{ $defn_of_statlines{league_standings_simple}{list} }; add_stat_to_statline_after_stat( 'RS', \@stats, 'ENDEND' ); add_stat_to_statline_after_stat( 'RA', \@stats, 'ENDEND' ); add_stat_to_statline_after_stat( 'win_loss_perc_pythag', \@stats, 'ENDEND' ); delete_stat_from_statline( 'team_abbrev', \@stats ); my $sth = $dbh->prepare($query) || croak qq{Error Running query\n$query\n}; my $return = $EMPTY_STR; $sth->execute() || croak qq{Error Running query exec\n$query\n} . $dbh->errstr; my %table_defn; my $line_count = 0; my $leader_games_over_500; my $division = $EMPTY_STR; my $lg_ID = $EMPTY_STR; while ( my $tmp = $sth->fetchrow_hashref ) { $tmp->{win_loss_perc_pythag} = SRlocal::Stats::get_pythagorean_win_loss( $tmp->{RS}, $tmp->{RA}, $tmp->{W} + $tmp->{L}, $TRUE ); if ( ( $lg_ID ne is_nonempty_print( $tmp->{lg_ID} ) ) || ( $do_separate_divisions && ( $division ne is_nonempty_print( $tmp->{DIVISION} ) ) ) ) { $return .= generate_statline_footer_wrap( \%table_defn ) if ($line_count); %table_defn = ( table_id => 'standings-' . $direction . '-' . $tmp->{lg_ID} . '-' . ( $do_separate_divisions ? $tmp->{DIVISION} : 'overall' ), title => sprintf( '%s %s', $tmp->{lg_ID}, $do_separate_divisions && ( $year > 1968 ) ? $SRlocal::Constants::DIVISION_NAME_OF{ $tmp->{DIVISION} } . ' Division' : ' Overall' ), comment_by_default => $FALSE, table_cols_to_freeze => 1, table_class => 'suppress_glossary', ); $return .= generate_statline_header_wrap( \%table_defn ); $return .= generate_statline_header( \@stats ); $leader_games_over_500 = $tmp->{games_over_500}; } $tmp->{games_back} = sprintf qq{%4.1f}, ( $leader_games_over_500 - $tmp->{games_over_500} ) / 2; $tmp->{games_back} = '--' if ( $tmp->{games_back} == 0 ); $return .= generate_statline( \@stats, $tmp ); $line_count++; $division = is_nonempty_print( $tmp->{DIVISION} ); $lg_ID = is_nonempty_print( $tmp->{lg_ID} ); } $return .= generate_statline_footer_wrap( \%table_defn ) if ($line_count); return scalar $return; }