#!/usr/bin/perl # AUTHORS # # Sean Forman # # Hans Van Slooten # $Date: 2017-02-20 15:32:58 -0500 (Mon, 20 Feb 2017) $ # $Author: mk $ # $Rev: 48980 $ # $HeadURL: http://svn.sports-reference.com/svn/br_repos/br/branches/2016-03-klecko/friv/milestones.cgi $ # Copyright 2000-2011, SPORTS REFERENCE, LLC All rights reserved. use strict; use warnings; # Get the site lib directory. use FindBin qw($Bin); use lib "$Bin/../lib"; # Change this to just three hashes to show all debugging. Comment out # to drop comments from output. #use Smart::Comments '####'; # Include other modules. use CGI; use Carp; use Tie::IxHash; # Include our local and global SR modules. use SR::Defaults; use SR::Statline; use SR::Cache; use SR::Formatting; use SRlocal::Stats; use SRlocal::Formatting; use SRlocal::Constants; use SRlocal::DB; chomp($0); #### [] Starting: "$Bin/$0 " . join(' ',@ARGV) # Tie the hash so we can retrieve things in insertion order. tie our %stats, "Tie::IxHash"; %stats = ( R => { min_value => 500, max_value => 2_5000, increment => 500, }, H => { min_value => 1_000, max_value => 4_000, increment => 500 }, HR => { min_value => 100, max_value => 1_000, increment => 50 }, RBI => { min_value => 1_000, max_value => 4_000, increment => 250, }, TB => { min_value => 1_000, max_value => 7_000, increment => 1_000, }, TOB => { min_value => 1_000, max_value => 6_000, increment => 1_000, }, '2B' => { min_value => 100, max_value => 900, increment => 100, }, '3B' => { min_value => 50, max_value => 300, increment => 50, }, BB => { min_value => 500, max_value => 2_500, increment => 500, }, SO => { min_value => 500, max_value => 2_500, increment => 500, }, SB => { min_value => 200, max_value => 800, increment => 100, }, G => { min_value => 1_000, max_value => 4_000, increment => 500, }, W => { min_value => 100, max_value => 600, increment => 50, }, SO_p => { min_value => 1_000, max_value => 5_000, increment => 500, }, IP => { min_value => 1_000, max_value => 6_000, increment => 1_000, }, SV => { min_value => 100, max_value => 600, increment => 100, }, GS => { min_value => 100, max_value => 700, increment => 100, }, G_p => { min_value => 300, max_value => 1_300, increment => 200, }, batters_faced => { min_value => 5_000, max_value => 30_000, increment => 5_000, }, E_tf => { min_value => 100, max_value => 300, increment => 50, }, A_tf => { min_value => 1_000, max_value => 8_000, increment => 1_000, }, PO_tf => { min_value => 2_000, max_value => 20_000, increment => 2_000, }, ); MAIN: { # Initialize CGI object. my $cgi = new CGI(); # Get the script parameters. my $stat_id = is_nonempty( $cgi->param('stat') ) ? $cgi->param('stat') : 'H'; # If we're given bad parameters then kill the script. if ( $stat_id && $stat_id !~ /^[A-z|0-9|\_]+$/ ) { print "Location: /friv/milestones.cgi\n\n"; exit; } if ( !defined $stats{$stat_id} ) { print "Location: /friv/milestones.cgi\n\n"; exit; } # Get the db handle and a reference to a hash of site params. our $dbh = get_site_db_connection($Bin); our $site_params_ref = get_site_params($Bin); my $srtemplates = new SRlocal::Templates; # see if we have a memd option here. our $memd = get_memcached_connection($Bin); my $memd_key = $ENV{'REQUEST_URI'}; my $page_data = SR::Cache::get_data_from_cache( { dbh => $dbh, memd => $memd, key => $memd_key } ); #my $page_data; print $cgi->header; # if we got data, print it. if ( is_nonempty($page_data) && !$cgi->param('bust_cache') ) { print $page_data; $dbh->disconnect; exit; } # Set up the "You Are Here" line. my $you_are_here = generate_you_are_here( [ ( sprintf "%s Milestones", $STATLINE_DEFAULTS{$stat_id}{name} ) ] ); # Set the page title. my $page_title = sprintf "MLB Milestone Watch: %s", $STATLINE_DEFAULTS{$stat_id}{name}; my %model; $model{header} = { page_title => $page_title, you_are_here => $you_are_here, qi_section => 'friv', page_url => $SRlocal::Constants::SITE_URL . '/friv/milestones.cgi', use_default_keywords => $FALSE, page_label => $page_title, page_description => $page_title, }; $model{inner_nav} = [ { index => $TRUE, label => "Frivolities Index", link => "/friv/" } ]; # Add a link for each milestone stat. my @nav_options; foreach my $key ( keys %stats ) { push @nav_options, sprintf qq{/friv/milestones.cgi?stat=%s:%s}, $key, $STATLINE_DEFAULTS{$key}{name}; } push @{ $model{pagecontent} }, output_goto_nav( { description_option => "Select Page", select_array => [ { select_ref => \@nav_options, selected => sprintf( qq{/friv/milestones.cgi?stat=%s:%s}, $stat_id, $STATLINE_DEFAULTS{$stat_id}{name} ), label => "Select a Statistic", } ], } ); my $output; my %table_defn = ( table_id => 'milestones', title => 'Milestones', table_cols_to_freeze => 1, comment_by_default => $FALSE, hide_long => $TRUE, table_wrapper_class => 'columns', ); my @stats = qw( player value needed ); local $STATLINE_DEFAULTS{needed}{justify} = 'left'; $output .= generate_statline_header_wrap( \%table_defn ); for ( my $value = $stats{$stat_id}{max_value}; $value >= $stats{$stat_id}{min_value}; $value -= $stats{$stat_id}{increment} ) { my $min_value = $value - 0.33 * $stats{$stat_id}{increment}; my $max_value = $value - 1; my $table = 'career_' . $STATLINE_DEFAULTS{$stat_id}{table}; my $range = qq{\n AND ($STATLINE_DEFAULTS{$stat_id}{select}) BETWEEN $min_value AND $max_value}; my $where = ' AND age=0' . $range; my $group = $EMPTY_STR; my $having = $EMPTY_STR; # fix the fielding entries. if ( $table eq 'career_fielding' ) { $table = 'majors_fielding'; $where = ' AND is_derived=0 AND total_season="T"'; $group = qq{GROUP BY bio.player_ID}; $having = qq{HAVING 1>0 $range}; } my $query = <<"END_SQL"; SELECT $defn_of_stat{player_name}{base} AS player, $defn_of_stat{player_link}{base} AS player_link, FORMAT($STATLINE_DEFAULTS{$stat_id}{select}, 0) AS value, $value - $STATLINE_DEFAULTS{$stat_id}{select} AS needed FROM $table INNER JOIN bio USING (player_ID) WHERE active='Y' $where $group $having ORDER BY value DESC END_SQL # Prepare and execute the query. my $sth = $dbh->prepare($query); #### Preparing Query $sth->execute() || croak "Query: Explain\n $query\n\n failed: " . $dbh->errstr . "\n\n"; #### Executing Query # See if our query returned any results. if ( $sth->rows > 0 ) { # Add commas to the value. ( my $value_format = $value ) =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g; $output .= generate_statline( \@stats, { LINE_class => 'thead', LINE_onecell => sprintf( qq{%s %s}, $value_format, $STATLINE_DEFAULTS{$stat_id}{name} ), td_class => 'center' } ); while ( my $tmp = $sth->fetchrow_hashref ) { $tmp->{needed} .= " to milestone"; $output .= generate_statline( \@stats, $tmp ); # End the row. } } $sth->finish; #### Query Finished } $output .= generate_statline_footer_wrap( \%table_defn ); push @{ $model{pagecontent} }, $output; # Print the career leaders table. push @{ $model{pagecontent} }, _get_career_leaders_for_stat( $dbh, $stat_id ); my $content = $srtemplates->process( 'Pages/General.tt2', \%model ); print $content; # stuff the page into our cache. SR::Cache::put_data_in_cache( { dbh => $dbh, memd => $memd, key => $memd_key, data => $content, } ); # Disconnect from the database. $dbh->disconnect; } ############################################################################## # Usage : _get_career_leaders_for_stat( $dbh, $stat_id ) # Purpose : Produces a table of career leaders for a given stat id. # Returns : A scalar that contains the table text. # Parameters : A database handle ($dbh) and the stat id. # Throws : no exceptions # Comments : none # See Also : n/a ############################################################################## sub _get_career_leaders_for_stat { my ( $dbh, $stat_id ) = @_; # Set up the query to pull the leaders for this stat. my $query = <<"END_SQL"; SELECT rank, $defn_of_stat{player_name}{base} AS player, if(active = 'Y',1,0) as is_active, $defn_of_stat{player_link}{base} AS player_link, IF(HOF="Y", '*', '') AS player_link_post, ROUND(value) AS value FROM majors_leaders INNER JOIN bio USING (player_ID) WHERE lg_id = 'ML' AND year_ID=9999 AND stat_id = ? AND rank <= 250 ORDER BY rank END_SQL # Prepare and execute the query. my $sth = $dbh->prepare($query); #### Preparing Query $sth->execute($stat_id) || croak "Query: Explain\n $query\n\n failed: " . $dbh->errstr . "\n\n"; #### Executing Query # Initialize our output variable. my $output = $EMPTY_STR; my %table_defn = ( table_id => 'leaders', title => sprintf( qq{MLB Career Leaders for %s}, $STATLINE_DEFAULTS{$stat_id}{name} ), table_cols_to_freeze => 2, comment_by_default => $FALSE, hide_long => $TRUE, table_wrapper_class => 'columns', ); my @stats = qw( ranker player value needed ); $output .= generate_statline_header_wrap( \%table_defn ); $output .= generate_statline_header( \@stats ); # Initialize some variables we'll use to track changes. my ( $last_rank, $last_value, $last_value_wo_ties, $last_rank_wo_ties ) = ( 0, 0, 0, 0 ); while ( my $tmp = $sth->fetchrow_hashref ) { $tmp->{ranker} = $tmp->{rank} if ( $tmp->{rank} != $last_rank ); $tmp->{player_bold} = $tmp->{is_active}; # Add a progress note for active leaders. my $rank_use = $tmp->{rank} == $last_rank ? $last_rank_wo_ties : $last_rank; my $value_use = $tmp->{rank} == $last_rank ? $last_value_wo_ties : $last_value; my $note = $tmp->{is_active} && $tmp->{rank} != 1 ? ( sprintf "(needs %s to move into %s place)", $value_use - $tmp->{value}, ordinate($rank_use) ) : " "; $tmp->{needed} = $note; # Add the formatted stat value. ( my $value_format = $tmp->{value} ) =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g; $tmp->{value} = $value_format; $output .= generate_statline( \@stats, $tmp ); # Store the last rank and value, and next-to-last for stats with lots # of ties. $last_rank_wo_ties = $last_rank if ( ( $last_rank != $last_rank_wo_ties ) && ( $last_rank != $tmp->{rank} ) ); $last_value_wo_ties = $last_value if ( ( $last_value ne $last_value_wo_ties ) && ( $last_value ne $tmp->{value} ) ); $last_rank = $tmp->{rank}; $last_value = $tmp->{value}; $last_value =~ s/,//g; $last_value_wo_ties =~ s/,//g; } $output .= generate_statline_footer_wrap( \%table_defn ); # Return the generated text. return scalar $output; } __END__