#!/usr/bin/perl # AUTHORS # Sean Forman # Hans Van Slooten # $Date: 2017-03-12 00:12:13 -0500 (Sun, 12 Mar 2017) $ # $Author: sean $ # $Rev: 49833 $ # $HeadURL: http://svn.sports-reference.com/svn/br_repos/br/trunk/register/player.fcgi $ # Copyright 2000-2017, SPORTS REFERENCE, LLC All rights reserved. ################################################################### # Usage : player.cgi # Purpose : returns a player card for a minor league player # Returns : a-z full webpage # Parameters : id (the sabr key_person which is a 15 character id # Throws : none # See Also : # Comments : ################################################################### use Carp; use CGI::Fast ':standard'; use Encode qw(decode_utf8 encode_utf8); use FindBin '$Bin'; use Modern::Perl '2010'; use open qw(:std :utf8); @ARGV = map { decode_utf8( $_, 1 ) } @ARGV; use lib "$Bin/../lib"; use SR::Cache; use SR::Defaults; use SR::Linker; use SR::Logging; use SR::Statline; use SRlocal::Constants; use SRlocal::Current; use SRlocal::DB; use SRlocal::Defaults; use SRlocal::Draft; use SRlocal::Formatting; use SRlocal::Players; use SRlocal::Players::Model; use SRlocal::Players::Fetch; use SRlocal::Register; use SRlocal::Register::Batting; use SRlocal::Register::Fetch; use SRlocal::Register::Fielding; use SRlocal::Register::Grids; use SRlocal::Register::Managers; use SRlocal::Register::Model; use SRlocal::Register::Pitching; use SRlocal::Register::Rosters; use SRlocal::Stats; use SRlocal::Templates; chomp($0); MAIN: { # Get the db handle and a reference to a hash of site params our $site_params_ref = get_site_params($Bin); our $dbh = get_site_db_connection($Bin); our $srtemplates = new SRlocal::Templates; $dbh->{mysql_auto_reconnect} = $TRUE; while ( my $q = new CGI::Fast ) { # Define the site header values within a hash and send the hash to # the header script. # Set the page title. my $id = _nempp( $q->param('id') ); if ( $id eq 'darvis001yu' ) { $id = 'darvis001yu-'; } my $dir = $SRlocal::Register::DIR; my $initial = url_regex( $q, 'initial', qr/[a-z]/, '' ) // ''; my $type = url_regex( $q, 'type', qr/[pb]gl/, '' ) // ''; my $year = url_integer( $q, 'year', 0 ); # build a unique id for this page's data, and retrieve from # mysql or memcached if available. Print if it is returned, # build if not and then add to cache. my $memd_key = "$id:$initial:$type:$year"; my $page_data = cache_get( 'register:player', $memd_key ); ################################################################### # check to see if we got a result from the cache ################################################################### if ( _nemp($page_data) && !_empz( $q->param('bust_cache') ) ) { print $q->header( -type => 'text/html', -charset => 'utf-8', -SR_SRC => 'memcached' ); print $page_data; next; } # get some more info for when we are doing gamelog and splts # pages for players. my $desc = qq{Statistics & History}; if ( is_nonempty_print( $q->param('type') ) =~ /gl/ ) { $desc = 'Gamelogs & Splits'; } $year = $EMPTY_STR; if ( is_nonempty_print( $q->param('year') ) =~ /[0-9][0-9]/ ) { $year = $q->param('year'); } my $page_title; # Set up the "You Are Here" line. my @yah; ################################################################### # get the initial directory of all players ################################################################### if ($initial) { $page_title = sprintf qq{Register Players Starting with "%s" Encyclopedia}, ucfirst($initial); # Set up the "You Are Here" line. @yah = ( qq{Register}, qq{Players}, qq{$page_title} ); } ################################################################### # get the directory of all initials ################################################################### elsif ( !$initial && !$id ) { $page_title = qq{Register Players Encyclopedia}; # Set up the "You Are Here" line. @yah = ( qq{Register}, qq{$page_title} ); } ################################################################### # We have a player id ################################################################### if ($id) { my $player = register_fetch_player_data( $dbh, { milb_id => $id } ); my $model = build_model_for_player_record( $dbh, $player, $TRUE ); my $leagues = register_fetch_player_leagues_label( $dbh, { milb_id => $id } ); my $subpage_type = $type eq 'pgl' || $type eq 'bgl' ? 'minor_gamelogs' : ''; # get the name out and get this going. my $player_name = is_nonempty_print( $player->{name_common} ); $page_title = qq{$player_name $year $leagues $desc}; @yah = ( qq{Register}, qq{Players}, qq{$player_name} ); $model->{header} = { you_are_here => generate_you_are_here( \@yah ), qi_section => 'players', page_title => $page_title, page_url => $SRlocal::Constants::SITE_URL . '/register/player.fcgi?id=' . $id, page_label => $page_title, page_description => qq{Batting, Pitching, and Fielding Statistics for Nearly Every Player back to 1900}, }; $model->{inner_nav} = get_player_inner_nav( $dbh, $type eq 'pgl' || $type eq 'bgl' ? '' : 'register', $subpage_type, $model ); # determine if this is a gamelog/splits or a basic page. if ( $id && $type =~ /gl/ ) { $model->{type} = $type; ## This gets both the player's splits and gamelog _get_player_log( $dbh, $model, $year ); } else { # Billy Horn see e-mail from him for March 26, 2015. if ( $id eq 'horn--001bil' ) { push @{ $model->{pagecontent} }, <<"...";

Note that we do not have pre-2005 Italian League Stats. Horn additionally played in the Italian League in 2003 & 2004, going 9-11 with a 3.91 ERA, 100 K and 37 BB over 147.1 IP. This brings his career totals to 9-12 with a 4.40 ERA in 184 IP.

... } # no hit in the cache, so we build the page in a # subroutine and return it to be printed here. #$query_ref->{dir} = $SRlocal::Register::DIR; _get_person_stat_output_minors( $dbh, $model, $srtemplates ); } # generate the page $page_data = $srtemplates->process( 'Pages/Player.tt2', $model ); } ################################################################### # We have an initial ################################################################### elsif ($initial) { my %model = (); $model{pagecontent} = []; # Define the site header values within a hash and send the hash to the # header script. $model{header} = { page_title => $page_title, page_url => $SRlocal::Constants::SITE_URL . '/register/player.fcgi?initial=' . $initial, you_are_here => '', qi_section => 'players', use_default_keywords => $FALSE, page_description => $page_title, }; $model{inner_nav} = build_register_inner_nav( $dbh, 'current', \%model ); # print out the players with this initial. # we will sort them by name and then by years played. push @{ $model{pagecontent} }, _get_player_initial_index( $dbh, $initial, $srtemplates ); $page_data = $srtemplates->process( 'Pages/General.tt2', \%model ); } ################################################################### # Create the overall index. ################################################################### else { my %model = (); $model{pagecontent} = []; $model{inner_nav} = build_register_inner_nav( $dbh, 'current', \%model ); # Define the site header values within a hash and send the hash to the # header script. $model{header} = { page_title => $page_title, page_url => $SRlocal::Constants::SITE_URL . '/register/player.fcgi', you_are_here => '', qi_section => 'players', use_default_keywords => $FALSE, page_description => $page_title, }; # print out the list of initials with the people matching. push @{ $model{pagecontent} }, _get_player_index( $dbh, $srtemplates ); $page_data = $srtemplates->process( 'Pages/General.tt2', \%model ); } ################################################################### # output the footer and then close up and stuff into memcached ################################################################### #print $fh $SRlocal::Register::DIR_NOTE; # open file for output print $q->header( -type => 'text/html', -charset => 'utf-8', -SR_SRC => 'build' ); print $page_data; cache_set( 'register:player', $memd_key, $page_data ); } $dbh->disconnect; } ################################################################### # Usage : _register_get_table_ordering($dbh, query_ref for player info) # Purpose : Tells us whether this is a pitcher or a hitter. # Returns : an array of tables to include. # Parameters : dbh, query_ref # Throws : ################################################################### sub _register_get_table_ordering { my ( $dbh, $model ) = @_; my @table_order = (); # we do pitching then batting if 3 * G_pitching > G_batting if ( $model->{bio}{data}{default_type} eq 'pitch' ) { @table_order = ( 'pitching', 'batting' ); } else { @table_order = ( 'batting', 'pitching' ); } push( @table_order, 'fielding' ); if ( $model->{bio}{data}{games_batted} < $model->{bio}{data}{games_managed} ) { @table_order = ( 'manager', @table_order ); } else { @table_order = ( @table_order, 'manager' ); } return scalar \@table_order; } ################################################################### # Usage : $page_data = _get_person_stat_output() # Purpose : returns the set of stats tables for this player # Returns : a large string # Parameters : dbh and a query_ref to a row in sabr_people # Throws : # See Also : # Comments : ################################################################### sub _get_person_stat_output_minors { my ( $dbh, $model, $srtemplates ) = @_; my @tables = @{ _register_get_table_ordering( $dbh, $model ) }; my $key_person = gtrc( $dbh, 'register_people', { milbID => $model->{milb_id} }, 'key_person' ); ## Display any prospect ranking info my $prospect = register_build_prospect_model( $dbh, $model, $model->{milb_id} ); push @{ $model->{pagecontent} }, $srtemplates->process( 'Partials/ContentSection/FlexGrid.tt2', $prospect ) if $prospect; ## attach the newsfeed to the page. push @{ $model->{pagecontent} }, SR::Linker::get_single_player_news( { dbh => $dbh, srtemplates => $srtemplates, player_id => $model->{id}, player_id_extra => $model->{milb_id} } ); push @{ $model->{pagecontent} }, _get_league_toggle_buttons( $dbh, $srtemplates, $key_person, $model->{id}, $model->{name_common} ); # Run through all of the tables for this player. my $comment_by_default = $FALSE; my $count = 0; foreach my $table (@tables) { if ( $table ne 'manager' ) { register_get_player_grid( $table, $dbh, $model, $srtemplates, $comment_by_default ); } else { SRlocal::Register::Managers::register_get_manager_from_id( $dbh, $model, $comment_by_default ); } $comment_by_default = $TRUE; $count++; } register_get_player_roster_from_id( $dbh, $model, $srtemplates, $comment_by_default ); # add the chadwick key_person here. push @{ $model->{pagecontent} }, qq{

Chadwick ID: $key_person

}; } ################################################################### # Usage : # Purpose : # Returns : # Parameters : # Throws : ################################################################### sub _get_league_toggle_buttons { my ( $dbh, $srtemplates, $key_person, $bbref_id, $player_name ) = @_; my ( $has_mlb, $has_minors, $has_foreign, $has_nlb, $has_other ) = _check_available_levels( $dbh, $key_person ); my $count = 0; $count++ if $has_mlb; $count++ if $has_minors; $count++ if $has_foreign; $count++ if $has_nlb; $count++ if $has_other; # No buttons needed if we only have 1 or fewer groups if ( $count < 2 ) { return ''; } my %quicknav = ( items => [] ); push @{ $quicknav{items} }, { id => 'mlb', label => 'Hide MLB', sr_toggler => { selector => '.table_wrapper .mlb', textopen => 'Hide', textclosed => 'Show', highlightselectors => $TRUE, starts => 'open', class => 'hidden', }, } if $has_mlb; push @{ $quicknav{items} }, { id => 'minors', label => 'Hide Minors', sr_toggler => { selector => '.table_wrapper .minors', textopen => 'Hide', textclosed => 'Show', highlightselectors => $TRUE, starts => 'open', class => 'hidden', }, } if $has_minors; push @{ $quicknav{items} }, { id => 'nlb', sr_toggler => { selector => '.table_wrapper .nlb', textopen => 'Hide', textclosed => 'Show', highlightselectors => $TRUE, starts => 'open', class => 'hidden', }, label => 'Hide NLB', } if $has_nlb; push @{ $quicknav{items} }, { id => 'foreign', label => 'Hide Foreign', sr_toggler => { selector => '.table_wrapper .foreign', textopen => 'Hide', textclosed => 'Show', highlightselectors => $TRUE, starts => 'open', class => 'hidden', }, } if $has_foreign; push @{ $quicknav{items} }, { id => 'other', label => 'Hide Other', sr_toggler => { selector => '.table_wrapper .other', textopen => 'Hide', textclosed => 'Show', highlightselectors => $TRUE, starts => 'open', class => 'hidden', }, } if $has_other; if ($bbref_id) { my $link; # check for managers if ( substr( $bbref_id, -2 ) eq '99' ) { if ( gtrc( $dbh, 'nonmlbpa', { player_id => $bbref_id }, 'COUNT(*)' ) ) { $link = sprintf "/nonmlbpa/%s.shtml", $bbref_id; } else { $link = sprintf "/managers/%s.shtml", $bbref_id; } } else { $link = sprintf "/players/%s/%s.shtml", substr( $bbref_id, 0, 1 ), $bbref_id; } } return $srtemplates->process( 'Partials/ContentSection/QuickNav.tt2', \%quicknav ); } ################################################################### # Usage : _check_available_levels($dbh, $key_person) # Purpose : # Returns : ( $has_mlb, $has_minors, $has_foreign, $has_nlb, $has_other ) # Parameters : # Throws : ################################################################### sub _check_available_levels { my ( $dbh, $key_person ) = @_; my $classifications = ''; # Build the switch of classifications and their groups for the SQL foreach my $classification ( keys %REGISTER_LEAGUE_GROUP ) { my $group = $REGISTER_LEAGUE_GROUP{$classification}; $classifications .= qq{WHEN '$classification' THEN '$group'\n}; } # Fetch all of the level classifications from the DB for his player my $sql = <<"..."; SELECT league_group FROM register_player_groups WHERE key_person = ?; ... my $sth = db_prepare_and_execute( $dbh, $sql, $key_person ); my ( $has_mlb, $has_minors, $has_foreign, $has_nlb, $has_other ) = ( $FALSE, $FALSE, $FALSE, $FALSE, $FALSE ); while ( my $row = $sth->fetchrow_hashref ) { if ( $row->{league_group} eq 'MLB' ) { $has_mlb = $TRUE; } if ( $row->{league_group} eq 'Minors' ) { $has_minors = $TRUE; } if ( $row->{league_group} eq 'Foreign' ) { $has_foreign = $TRUE; } if ( $row->{league_group} eq 'NLB' ) { $has_nlb = $TRUE; } if ( $row->{league_group} eq 'Other' ) { $has_other = $TRUE; } } return ( $has_mlb, $has_minors, $has_foreign, $has_nlb, $has_other ); } ################################################################### # Usage : # Purpose : # Returns : # Parameters : # Throws : ################################################################### sub _get_player_log { my ( $dbh, $model, $year ) = @_; my @tables = @{ _register_get_table_ordering( $dbh, $model ) }; if (( $model->{type} eq 'bgl' ) || ( ( $tables[0] =~ /batting/ ) && ( $model->{type} ne 'pgl' ) ) ) { if ( !$year ) { $year = gtrc( $dbh, 'bgl_mlbam', { batter_id => $model->{bio}{data}{key_mlbam} }, 'MAX(year_game)' ); } push @{ $model->{pagecontent} }, SRlocal::Register::Batting::register_get_batting_gamelogs( $dbh, $model, $year, $FALSE ); push @{ $model->{pagecontent} }, SRlocal::Register::Batting::register_get_batting_splits( $dbh, $model, $year ); } elsif ( $model->{type} eq 'pgl' || ( $tables[0] =~ /pitching/ && $model->{type} ne 'bgl' ) ) { if ( !$year ) { $year = gtrc( $dbh, 'pgl_mlbam', { pitcher_id => $model->{bio}{data}{key_mlbam} }, 'MAX(year_game)' ); } push @{ $model->{pagecontent} }, SRlocal::Register::Pitching::register_get_pitching_gamelogs( $dbh, $model, $year, $FALSE ); push @{ $model->{pagecontent} }, SRlocal::Register::Pitching::register_get_pitching_splits( $dbh, $model, $year ); } } ################################################################### # Usage : _get_player_initial_index # Purpose : provides a formatted list of the players with these initials in the db. # Returns : a page fragment # Parameters : dbh # Throws : none # Comments : Just a long list of players sorted in alphabetical order ################################################################### sub _get_player_initial_index { my ( $dbh, $initial, $srtemplates ) = @_; my $return = $EMPTY_STR; # Get all of the initials in the db. my $query = <<"END_SQL"; SELECT key_person, milbID, name_common, name_given, birth_year, death_year, first_year, last_year, seasons FROM register_people_career_summary WHERE last_name_start = ? ORDER BY name_last ASC, name_first ASC, last_year DESC END_SQL my $sth = db_prepare_and_execute( $dbh, $query, $initial ); my $line_count = 0; while ( my $tmp = $sth->fetchrow_hashref ) { $line_count++; # print out # bold if active # name with link to page # given name. # birthYear if known # played years. $return .= sprintf( qq{
%s%s%s%s%s%s%s\n}, $tmp->{last_year} && $tmp->{last_year} >= $CURRENT_YEAR ? '' : $EMPTY_STR, $tmp->{milbID}, $tmp->{name_common}, $tmp->{last_year} && $tmp->{last_year} >= $CURRENT_YEAR ? '' : $EMPTY_STR, is_nonempty( $tmp->{name_given} ) ? ', gn. ' . $tmp->{name_given} : $EMPTY_STR, is_nonempty( $tmp->{birth_year} ) ? ', b. ' . $tmp->{birth_year} : $EMPTY_STR, is_nonempty( $tmp->{death_year} ) ? ', d. ' . $tmp->{death_year} : $EMPTY_STR, is_nonempty( $tmp->{last_year} ) ? ', played ' . ( !$tmp->{last_year} && !$tmp->{first_year} ? '' : !$tmp->{last_year} ? $tmp->{first_year} : !$tmp->{first_year} ? $tmp->{last_year} : $tmp->{last_year} == $tmp->{first_year} ? $tmp->{last_year} : $tmp->{first_year} . '-' . $tmp->{last_year} ) : $EMPTY_STR ); } my $include_s = $line_count == 1 ? $EMPTY_STR : 's'; $line_count = commify_number($line_count); my $title = sprintf qq{%s Player%s Listed Starting with "%s"}, $line_count, $include_s, ucfirst( lc($initial) ); return output_content_section( { section_content => $return, section_id => 'players_' . $initial, title => $title, comment_by_default => $FALSE, section_heading_text => '', srtemplates => $srtemplates, } ); } ################################################################### # Usage : _get_player_index # Purpose : provides a formatted list of the initials in the db. # Returns : a page fragment # Parameters : dbh # # Comments : This produces an index with big letters down the left and # the first two letters of the last name in the rows. # A: Aa Ab Ac ... # B: Ba Bb .. etc. ################################################################### sub _get_player_index { my ( $dbh, $srtemplates ) = @_; my $return = $EMPTY_STR; # we modify our alphabet to include the apostrophe the O'leary's # etc. my @alphabet = ( "'", @ALPHABET ); # Get all of the initials in the db. my $query = <<"END_SQL"; SELECT LEFT(LOWER(name_last),2) AS left_inits FROM register_people GROUP BY left_inits END_SQL my $sth = db_prepare_and_execute( $dbh, $query ); my %init_exists = (); while ( my $tmp = $sth->fetchrow_hashref ) { $init_exists{ $tmp->{left_inits} } = $TRUE; } my $note = ''; my $player_count = commify_number( gtrc( $dbh, 'register_players_list', {}, 'count(*)' ) ); my $title = qq{Professional Baseball Register\n}; $note .= <<"END_HTML";

Over $player_count players, managers and other people from Negro, Japanese, Cuban, an Minor League history. This list is not exhaustive and may be missiplayers from certain leagues and years or with a small number of appearances. We apologize for any omissions.

END_HTML $return .= qq{}; return output_content_section( { section_content => $return, section_id => 'players', title => $title, comment_by_default => $FALSE, section_heading_text => '', srtemplates => $srtemplates, } ); } ################################################################### # Usage : # Purpose : # Returns : # Parameters : # Throws : ################################################################### sub _register_get_player_nav { my ( $dbh, $query_ref, $type, $year_select ) = @_; my $return = $EMPTY_STR; $return .= sprintf qq{
%s
}, is_nonempty_print( $query_ref->{name_common} ); my $title = 'Register Player Page'; if ( is_empty($type) ) { $return .= sprintf qq{
%s
}, $title; } else { $return .= sprintf qq{ }, $query_ref->{milbID}, $title; } my $pgl_has = gtrc( $dbh, 'psplit_mlbam', { pitcher_id => $query_ref->{key_mlbam} }, 'GROUP_CONCAT(distinct year_game order by year_game desc)' ); my $bgl_has = gtrc( $dbh, 'bsplit_mlbam', { batter_id => $query_ref->{key_mlbam} }, 'GROUP_CONCAT(distinct year_game order by year_game desc)' ); my $return_gl = $EMPTY_STR; if ( ( is_empty_zero( $query_ref->{key_mlbam} ) == 0 ) || ( is_nonempty($pgl_has) + is_nonempty($bgl_has) == 0 ) ) { # no gamelogs or splits, so print nothing. return $EMPTY_STR; } else { $return .= '
/ Gamelogs & Splits
'; # get the years. $return .= qq{
\n}; if ( is_nonempty($pgl_has) ) { $return .= qq{Pitching: \n}; my @logs = (); foreach my $year ( split ',', $pgl_has ) { if ( $year_select && $year == $year_select && $type eq 'pgl' ) { push( @logs, sprintf( qq{%s\n}, $year ) ); } else { push( @logs, sprintf( qq{%s\n}, $query_ref->{milbID}, $year, $year ) ); } } $return .= join( ' / ', @logs ); $return .= qq{
} if ( is_nonempty($bgl_has) ); } if ( is_nonempty($bgl_has) ) { $return .= qq{ Batting: \n}; my @logs = (); foreach my $year ( split ',', $bgl_has ) { if ( $year_select && $year == $year_select && $type eq 'bgl' ) { push( @logs, sprintf( qq{%s\n}, $year ) ); } else { push( @logs, sprintf( qq{%s\n}, $query_ref->{milbID}, $year, $year ) ); } } $return .= join( ' / ', @logs ); } $return .= qq{
\n}; } $return .= qq{
\n
}; return scalar $return; } #### [] Finished: "$Bin/$0 " . join(' ',@ARGV)