#!/usr/bin/perl # AUTHORS # Sean Forman # Hans Van Slooten # $Date: 2017-04-25 18:38:59 -0400 (Tue, 25 Apr 2017) $ # $Author: hvs $ # $Rev: 51330 $ # $HeadURL: http://svn.sports-reference.com/svn/br_repos/br/trunk/friv/numbers.cgi $ # Copyright 2000-2017, SPORTS REFERENCE, LLC All rights reserved. use Carp; use CGI; use FindBin qw($Bin); 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::Templates; chomp($0); MAIN: { # Connect to the database. my $cgi = new CGI; my $memd_key = _nempp( $ENV{'REQUEST_URI'} ); my $page_data = cache_get( 'friv:numbers', $memd_key ); # if we got data, print it. if ( _nemp($page_data) && !$cgi->param('bust_cache') ) { print $cgi->header( -type => 'text/html', -charset => 'utf-8', -SR_SRC => 'memcached' ); print $page_data; exit; } our $dbh = get_site_db_connection($Bin); our $site_params_ref = get_site_params($Bin); my $srtemplates = new SRlocal::Templates; ##################################################################################### ##################################################################################### my $num = is_empty( $cgi->param('number') ) ? 7 : $cgi->param('number'); my $year = is_empty_zero( $cgi->param('year') ); # make sure our params are numbers for XSS reasons $num = 7 if ( $num !~ m/^\d+?$/ ); $year = $CURRENT_YEAR if ( $year && $year !~ m/^\d+?$/ ); # Build the page start my $page_title = sprintf qq{MLB Players Who Wore Number %s}, $num; $page_title .= ' in ' . $year if ($year); my $yah = generate_you_are_here( [ qq{Frivolities}, qq{$page_title} ] ); my %model; $model{header} = { page_title => $page_title, you_are_here => $you_are_here, qi_section => 'friv', page_url => $SRlocal::Constants::SITE_URL . '/friv/numbers.cgi', use_default_keywords => $FALSE, page_label => $page_title, page_description => $page_title, }; $model{inner_nav} = [ { index => $TRUE, label => "Frivolities Index", link => "/friv/" } ]; my %form_params = ( method => 'get', action => '/friv/numbers.cgi', id => 'numbers', class => 'no_chosen', fields => [ { group => $TRUE, linear => $TRUE, subfields => [ { label => 'Number', name => 'number', type => 'number', size => 5, max => 2, range => [ 0, 99 ] }, { label => 'Year', name => 'year', type => 'dropdown', start => $SRlocal::Constants::FIRST_YEAR_UNIFORMS, end => $CURRENT_YEAR, option_start => { value => '', label => qq{Any} }, }, { type => 'submit', val => 'Search' } ] } ] ); my $form_template = $srtemplates->process( 'Partials/Forms/Form.tt2', \%form_params ); ## Get the active franchise ids sorted by their full name my @franchs_local = sort { $SRlocal::Constants::FRANCHISE_FULL_NAME_OF{$a} cmp $SRlocal::Constants::FRANCHISE_FULL_NAME_OF{$b} } @SRlocal::Constants::ACTIVE_FRANCHISES; ## Build the navigation list my @nav_list; for my $franch_id (@franchs_local) { push @nav_list, qq{/teams/$franch_id/uniform-numbers.shtml:$SRlocal::Constants::FRANCHISE_FULL_NAME_OF{$franch_id}}; } $form_template .= SR::Defaults::output_goto_nav( { srtemplates => $srtemplates, fieldset_label => "Or go to a franchise's uniform history:", not_linear => $FALSE, select_array => [ { select_ref => \@nav_list, desc_option => 'Choose a Team' }, ], } ); push @{ $model{pagecontent} }, $form_template; $STATLINE_DEFAULTS{player}{header} = 'Player'; if ($year) { push @{ $model{pagecontent} }, _get_year_players( $dbh, $num, $year ); } else { push @{ $model{pagecontent} }, _get_all_players( $dbh, $num, $year ); } my $output = $srtemplates->process( 'Pages/General.tt2', \%model ); print $cgi->header( -type => 'text/html', -charset => 'utf-8', -SR_SRC => 'build' ); print $output; cache_set( 'friv:numbers', $memd_key, $output ); ##################################################################################### # Close up the page and db. $dbh->disconnect; } ################################################################### # Usage : _get_year_players # Purpose : provides a list of players with a # in a season # Returns : an html table # Parameters : dbh, num, year # Throws : ################################################################### sub _get_year_players { my ( $dbh, $num, $year ) = @_; my $return = $EMPTY_STR; my $ranker = 0; my $query = _get_query(); my @stats = _get_stats(); my $sth = $dbh->prepare($query); # Run the query for this award. $sth->execute( $num, $year ) || croak "query failed:\n\n$query\nyear:$year,num:$num"; # See if our query returned any rows. If it didn't, we're done. if ( $sth->rows ) { my %table_defn = ( table_id => 'uniform_number', title => 'Uniform Numbers', table_cols_to_freeze => 1, comment_by_default => $FALSE, hide_long => $TRUE ); # Use Statline to start the table and get the table header. $return .= generate_statline_header_wrap( \%table_defn ); $return .= generate_statline_header( \@stats, { use_over_header => $TRUE, } ); # Loop through the query results. while ( my $tmp = $sth->fetchrow_hashref ) { # Use Statline to add the season stat lines. $return .= generate_statline( \@stats, $tmp ); } $return .= generate_statline_footer_wrap( \%table_defn ); } return scalar $return; } ################################################################### # Usage : get_query # Purpose : # Returns : returns a sql select command to generate a stats summary # Parameters : award # Throws : # See Also : # Comments : ################################################################### sub _get_query { # REturn the default. my $query = <<"END_SQL"; SELECT CONCAT('/players/',left(bio.player_ID,1),'/',bio.player_ID,'.shtml') AS player_link, name_common AS player, concat(bio.name_last,',',bio.name_first) AS player_csk, c.WAR, CONCAT('/teams/',pu.team_ID,'/',pu.year_ID,'-roster.shtml#team_unis') AS team_ID_link, pu.team_ID, $defn_of_statlines{multi_player_season_simple}{select}, a.Pos AS pos_summary FROM bio INNER JOIN players_unis pu using (player_ID) LEFT JOIN majors_batting AS a ON a.player_ID=bio.player_ID AND a.year_ID=pu.year_ID AND a.team_ID=pu.team_ID LEFT JOIN majors_pitching AS b ON b.player_ID=bio.player_ID AND b.year_ID=pu.year_ID AND b.team_ID=pu.team_ID LEFT JOIN majors_appearances AS c ON c.player_ID=bio.player_ID AND c.year_ID=pu.year_ID AND c.team_ID=pu.team_ID WHERE pu.uni_number=? AND pu.year_ID=? ORDER BY bio.name_last, bio.name_first, pu.team_ID END_SQL return $query; } ################################################################### # Usage : _get_stats # Purpose : # Returns : an array of stats. # Parameters : award_id # Throws : # See Also : # Comments : ################################################################### sub _get_stats { my @stats = ( 'player', 'team_ID', 'WAR', @{ $defn_of_statlines{multi_player_season_simple}{list} }, ); return @stats; } ################################################################### # Usage : _get_all_players # Purpose : provides a list of players with a # all-time # Returns : an html table # Parameters : dbh, num # Throws : ################################################################### sub _get_all_players { my ( $dbh, $num, $year ) = @_; my $return = $EMPTY_STR; $STATLINE_DEFAULTS{team_ID}{header} = 'Team (click to sort by first year)'; my $query = <<"END_SQL"; SELECT $defn_of_statlines{player_name}{select}, COUNT(distinct players_unis.year_ID) as seasons, bio.player_ID, (SELECT SUM(WAR) as WAR FROM majors_appearances ma WHERE ma.player_ID=bio.player_ID) AS WAR FROM bio INNER JOIN players_unis USING (player_ID) WHERE uni_number=? GROUP BY bio.player_ID ORDER BY name_last, name_first END_SQL # fix an issue with name last and name first. $query =~ s/name_last/bio.name_last/g; $query =~ s/name_first/bio.name_first/g; my $sth = $dbh->prepare($query) || croak( "query failed: \n $query\n " . $dbh->errstr . "\n" ); $sth->execute($num) || croak( "execute failed: \n $query\n " . $dbh->errstr . "\n" ); my @stats = qw(player seasons WAR team_ID); if ( $sth->rows ) { my %table_defn = ( table_id => 'uniform_number', title => 'Uniform Numbers', table_cols_to_freeze => 1, comment_by_default => $FALSE, hide_long => $TRUE ); # Use Statline to start the table and get the table header. $return .= generate_statline_header_wrap( \%table_defn ); $return .= generate_statline_header( \@stats ); while ( my $tmp = $sth->fetchrow_hashref ) { $tmp->{team_ID} = _get_player_number_team_list( $dbh, $tmp->{player_ID}, $num ); # extract the first year. $tmp->{team_ID} =~ /amp;year=(....)/; $tmp->{team_ID_csk} = $1; # Use Statline to add the season stat lines. $return .= generate_statline( \@stats, $tmp ); } $sth->finish; $return .= generate_statline_footer_wrap( \%table_defn ); } return scalar $return; } ################################################################### # Usage : # Purpose : # Returns : # Parameters : # Throws : ################################################################### sub _get_player_number_team_list { my ( $dbh, $player_id, $num ) = @_; my $return = $EMPTY_STR; my $query = <<"END_SQL"; SELECT mt.name, GROUP_CONCAT(mt.year_ID ORDER BY mt.year_ID SEPARATOR ',') as years, min(mt.year_ID) AS min_year FROM players_unis INNER JOIN majors_team mt using (year_ID, team_ID) WHERE player_ID=? AND uni_number=? GROUP BY mt.name ORDER BY min_year ASC END_SQL my $sth = $dbh->prepare($query) || croak( "query failed: \n $query\n " . $dbh->errstr . "\n" ); $sth->execute( $player_id, $num ) || croak( "execute failed: \n $query\n " . $dbh->errstr . "\n" ); my @teams = (); while ( my $tmp = $sth->fetchrow_hashref ) { # split up the years my @years = (); foreach my $yr ( split( ',', $tmp->{years} ) ) { push( @years, sprintf( qq{%s}, $yr, substr( $yr, 2, 2 ) ) ); } my $year_split = '(' . join( ', ', @years ) . ')'; push( @teams, $tmp->{name} . $SPACE . $year_split ); } $sth->finish; return join( " ", @teams ); } ################################################################### # Usage : # Purpose : # Returns : # Parameters : # Throws : ################################################################### sub _get_number_options { my ($num) = @_; my $return = $EMPTY_STR; $return .= qq{Select number:\n\n }; return scalar $return; } ################################################################### # Usage : # Purpose : # Returns : # Parameters : # Throws : ################################################################### sub _get_year_options { my ($year) = @_; my $return = $EMPTY_STR; $return .= qq{ Select a season:\n\n }; return scalar $return; }