#!/usr/bin/perl # AUTHORS # Sean Forman # Hans Van Slooten # $Date: 2017-04-18 09:15:47 -0400 (Tue, 18 Apr 2017) $ # $Author: hvs $ # $Rev: 51013 $ # $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 Data::Dumper; use Encode qw(decode_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, $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 ); $model->{header}{qi_section} = 'players'; $model->{header}{page_title} = $page_title; $model->{header}{page_url} = $SRlocal::Constants::SITE_URL . '/register/player.fcgi?id=' . $id; $model->{header}{page_label} = $page_title; $model->{header}{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 missing players 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, } ); } #### [] Finished: "$Bin/$0 " . join(' ',@ARGV)