#!/usr/bin/perl -w # AUTHOR # Sean Forman # Hans Van Slooten # $Date: 2017-03-07 13:26:23 -0500 (Tue, 07 Mar 2017) $ # $Author: hvs $ # $Rev: 49710 $ # $HeadURL: http://svn.sports-reference.com/svn/br_repos/br/trunk/play-index/split_finder.cgi $ # Copyright 2000-2017, SPORTS REFERENCE, INC. All rights reserved. use Carp; use CGI::Fast ':standard'; use FindBin qw($Bin); use JSON; use Modern::Perl '2010'; use lib "$Bin/../lib"; use SR::Auth::Users; use SR::Cache; use SR::Defaults; use SR::Logging; use SR::Statline; use SRlocal::DB; use SRlocal::Defaults; use SRlocal::Formatting; use SRlocal::Constants; use SRlocal::PlayIndex; use SRlocal::PlayIndex::Formatting; use SRlocal::PlayIndex::Subscribe; use SRlocal::PlayIndex::Constants; use SRlocal::PlayIndex::Statdefine; use SRlocal::PlayIndex::SplitFinder; use SRlocal::Retrosheet::Plays; use SRlocal::Stats; use SRlocal::Templates; chomp($0); #### [] Starting: "$Bin/$0 " . join(' ',@ARGV) MAIN: { our $dbh = get_site_db_connection( $Bin, $SRlocal::PlayIndex::Constants::PI_DSN ); our $dbhSR = get_site_db_connection( $Bin, 'SR' ); our $site_params_ref = get_site_params($Bin); our $srtemplates = new SRlocal::Templates(); while ( my $q = new CGI::Fast ) { ################################################################## # Get our data out and set up our request. ################################################################## our %user = (); if ( $ENV{'HTTP_COOKIE'} ) { %user = %{ SR::Auth::Users::get_user($q) }; } my $sub_level = SRlocal::PlayIndex::Subscribe::subscriber_level( $dbhSR, $user{user_ID}, 'pi_subscribe' ); my $player_id = url_player_id( $q, 'id', '' ); my $year = url_alphanum( $q, 'year', 0 ); my $type = url_regex( $q, 'type', qr/^(b|p)$/, 'b' ); my $class = url_regex( $q, 'class', qr/^(team|player)$/, 'player' ); my $is_ajax = url_regex( $q, 'ajax', qr/^1$/, $FALSE ); my $is_submitted = url_regex( $q, 'request', qr/^1$/, $FALSE ); my $describe_only = url_regex( $q, 'describe_only', qr/^1$/, $FALSE ); my $split_selected = url_regex( $q, 'split_1', qr/^[a-z0-9_:]+$/, 'total:total' ); our $title = ( $class eq 'team' ? 'Team ' : $EMPTY_STR ) . ( $type eq 'b' ? 'Batting' : $type eq 'p' ? 'Pitching' : 'Other' ) . ' Split Finder'; our $page_url = $SRlocal::Constants::SITE_URL . '/play-index/split_finder.cgi?'; if ($player_id) { my $player_name = gtrc( $dbh, 'bio', { player_ID => $player_id }, 'name_common' ); $title .= $SPACE . '—' . $SPACE . $player_name; } my @yah = ( 'Play Index', qq{$title} ); my $model = { header => { page_title => $title, page_url => $page_url, you_are_here => generate_you_are_here( \@yah ), qi_section => 'play_index', page_description => 'Find single-season or multi-year splits by team, position, age and more', }, form_id => 'split_finder', description => ' ', }; if ( !$describe_only ) { my $form_settings = _get_split_form( $dbh, $q, $srtemplates, $model, $class, $type, $player_id, $split_selected ); ## Generate the PI form $model->{form_output} = $srtemplates->process( 'Partials/Forms/Form_PI.tt2', $form_settings ); ## Add a note about data availablity $model->{note} = $SRlocal::PlayIndex::Constants::DATA_SEASONS; } # if this is a form submission, ajax or not, get the results. if ( is_empty_zero( $q->param('request') ) == 1 ) { $model = SRlocal::PlayIndex::SplitFinder::run_report( $dbh, $srtemplates, $model, { sub_level => $sub_level, user => $user{user_ID}, id => $player_id, type => $type, class => $class, q_param => $q, describe_only => $describe_only, } ); } ## Generate the page my $page_data; if ( !$describe_only ) { $page_data = $srtemplates->process( 'Pages/PlayIndex.tt2', $model ); } else { $page_data = encode_json( $model->{description_array} ); } ## Output the file to the user print $q->header( -type => ( !$describe_only ? 'text/html' : 'text/json' ), -charset => 'utf-8', -SR_SRC => 'build' ); print $page_data; } # cleanup and exit. $dbhSR->disconnect; $dbh->disconnect; } ################################################################################ # Print out the form for the batters. ################################################################################ ################################################################### # Usage : zzzz # Purpose : zzzz # Returns : zzzz # Parameters : zzzz # Throws : zzzz # See Also : zzzz # Comments : zzzz ################################################################### sub _get_split_form { my ( $dbh, $cgi, $srtemplates, $model, $class, $type, $player_id, $split_selected ) = @_; my $result_player = $EMPTY_STR; if ( $type eq 'p' && $class eq 'team' ) { $result_player = 'team_pitching'; } elsif ( $type eq 'b' && $class eq 'team' ) { $result_player = 'team_batting'; } elsif ( $type eq 'p' ) { $result_player = 'result_pitcher'; } elsif ( $type eq 'b' ) { $result_player = 'result_batter'; } else { return $EMPTY_STR; } my $year_min = is_empty($player_id) ? $FIRST_YEAR_RETRO : gtrc( $dbh, 'players', { player_ID => $player_id }, 'year_min' ); my $year_max = is_empty($player_id) ? $CURRENT_YEAR_RETRO : gtrc( $dbh, 'players', { player_ID => $player_id }, 'year_max' ); my $report = $class eq 'team' ? 't' . $type : $type; my $match = _nempp( $cgi->param('match'), 'season' ); my $type_name = $type eq 'b' ? 'batting' : 'pitching'; my $type_name_2 = $type eq 'b' ? 'batter' : 'pitcher'; ## Build the report type selector my $form_top_options = { fields => [ { name => 'match', type => 'radio', val => $match, choices => [] } ] }; my $additional_criteria_total = SRlocal::PlayIndex::Constants::get_form_additional_criteria( 'split_finder_compare', $type, 'player', $cgi ); my $split_select_box = _get_split_select_box( $dbh, $type, 'player', 1, $split_selected ); ## Add all of the report types to the form foreach my $option ( @{ $PI_SPLIT_FINDER_DETAILS{$report}{types} } ) { my $choice = { label => $PI_SPLIT_FINDER_TYPES{$class}{$option} . ' (' . $PI_SPLIT_FINDER_DETAILS{$report}{match}{$option} . ')', val => $option, sr_preset => { hide => ( $option eq 'career' ? '.game_year,.team_id' : '' ), show => ( $option ne 'career' ? '.game_year,.team_id' : '' ), } }; push @{ $form_top_options->{fields}[0]{choices} }, $choice; } ## Build the main part of the PI form my $form_main = { fields => [ { type => 'hidden', name => 'as', val => ( $class eq 'team' ? 'team_' . $type_name : 'result_' . $type_name_2 ) }, { type => 'hidden', name => 'class', val => $class }, { type => 'hidden', name => 'offset', val => 0 }, { type => 'hidden', name => 'type', val => $type }, @{ $PI_SPLIT_FINDER_DETAILS{$report}{additional_fields} }, ], }; ## Split Selector push @{ $form_main->{fields} }, $split_select_box; ## Split Compare Total push @{ $form_main->{fields} }, $additional_criteria_total if $additional_criteria_total; push @{ $form_main->{fields} }, { type => 'hidden', name => 'id', val => $player_id } if $player_id; ## Build the filter criteria control my $form_criteria = SRlocal::PlayIndex::Constants::get_form_additional_criteria( 'split_finder', $report, $class, $cgi ); ## Build the sort control my $form_sort = SRlocal::PlayIndex::Constants::get_orderby_box( $PI_SPLIT_FINDER_DETAILS{$report}{order_by}, $PI_SPLIT_FINDER_DETAILS{$report}{order_by_default}, undef, { show_totals_choice => $TRUE, show_pitching_output_options => ( $type eq 'p' ), cgi => $cgi, } ); ## Build the final form details my $form_settings = { method => 'get', action => '/play-index/split_finder.cgi', name => 'split_finder', formdata => scalar $cgi->Vars, form_sort => $form_sort, form_top_options => $form_top_options, form_main => $form_main, form_criteria => $form_criteria, }; return $form_settings; } ################################################################### # Usage : _get_split_select_box # Purpose : provides an interactive list of splits. # Returns : a set of html select boxes (mostly hidden) # Parameters : dbh, type (b or p), class (player or team) # Throws : ################################################################### sub _get_split_select_box { my ( $dbh, $type, $class, $number, $split_selected ) = @_; return undef if ( is_empty($type) || is_empty($class) || is_empty($number) ); # check to see if we have this set up in the memd already. my $key = qq{$type:$class:$number}; # check the cache for the data. my $return = cache_get( 'split_finder:select', $key ); if ( _nemp($return) ) { _display_correct_split_select_box( $return->{subfields}, $split_selected ); return $return; } # get the subgroup id's, We need to make sure we limit the splits # shown to those that are appropriate for team and player batting # or pitching splits specifically as appropriate. my $table_split = ( $type eq 'b' ) ? 'bsplit' : 'psplit'; my $table_prefix = ( $class eq 'team' ) ? 't' : $EMPTY_STR; my $table_split_order = $table_split . '_order'; $table_split = $table_prefix . $table_split; my $from_entry = qq{$table_split_order as split_order INNER JOIN $table_split ON gid=group_id AND sid=subgroup_id AND snm=split_name}; my $exclude_totals = $EMPTY_STR; $exclude_totals = qq{AND !(group_id='total' AND split_name='Total')} if ( $class ne 'team' ); # Get all of the subgroup id's for this finder my $query = <<"END_SQL"; SELECT SQL_CACHE gid, sid, min(split_order.spo) AS first FROM $from_entry WHERE 1>0 $exclude_totals GROUP BY gid, sid ORDER BY first ASC END_SQL my $sth = db_prepare_and_execute( $dbh, $query ); ## Create all of the Split Subgroup Options my $options = []; while ( my $tmp = $sth->fetchrow_hashref ) { push @$options, { val => qq{$tmp->{gid}:$tmp->{sid}}, label => $SRlocal::Constants::SPLIT_SUBGROUP_NAME{ $tmp->{sid} }, }; } ## Now go through the list and get all of the possible dropdowns we have to toggle my @available = map { ( my $val = $_->{val} ) =~ s/:/_/; ".sid_" . $val } @$options; ## Now, enable the sr_preset toggles foreach my $option (@$options) { ( my $val = $option->{val} ) =~ s/:/_/; my $selected = ".sid_" . $val; ## Hide everything except the selected my $hide = join( ',', grep( !/^$selected$/, @available ) ); $option->{sr_preset} = { hide => $hide, show => "$selected" }; } ## Create the Split dropdown $return = { group => $TRUE, subfields => [] }; push @{ $return->{subfields} }, { type => 'dropdown', no_chosen => $TRUE, name => qq{split_$number}, label => 'Choose Split Type', choices => $options, sr_preset => { 'preset-type' => 'change', select => '1' }, }; ################################################################################## # select the specific split we want given a specific subgroup. By # default all of these will be hidden and will not appear until # the subgroup is selected in the select box defined above. ################################################################################## my %sid = (); $query = <<"END_SQL"; SELECT SQL_CACHE gid, sid, snm, split_order.spo, gid as group_id, sid AS subgroup_id, snm AS split_name FROM $from_entry GROUP BY gid,sid,snm ORDER BY split_order.spo ASC END_SQL $sth = db_prepare_and_execute( $dbh, $query ); # run through and build each subgroups corresponding splits. while ( my $tmp = $sth->fetchrow_hashref ) { $tmp->{type_of_split} = ( $type eq 'b' ) ? 'bat' : 'pitch'; my $split_year_id = gtrc( $dbh, $table_split, { group_id => $tmp->{gid}, subgroup_id => $tmp->{sid}, split_name => $tmp->{snm} }, 'MAX(year_game)' ); $tmp->{type_of_split} = ( $type eq 'b' ) ? 'bat' : 'pitch'; $tmp->{year_id} = $split_year_id; # make sure we don't add a year to the split name for totals. $tmp->{suppress_year_on_totals} = $TRUE; my $split_name_clean = SRlocal::Constants::_clean_split_name( $dbh, $tmp, $split_year_id ); push @{ $sid{qq{$tmp->{gid}:$tmp->{sid}}} }, { val => "$tmp->{gid}:$tmp->{sid}:$tmp->{snm}", label => $split_name_clean }; } foreach my $key ( keys %sid ) { my $div_key = $key; $div_key =~ s/:/_/g; push @{ $return->{subfields} }, { type => 'dropdown', name => "sid_$key", label => 'Choose a Split', no_chosen => $TRUE, toggleable => $TRUE, val => "$key:any", class => "sid_$div_key", choices => [ { val => "$key:any", label => 'Match any Listed' }, @{ $sid{$key} } ] }; } push @{ $return->{subfields} }, { type => 'boolean', name => 'exclude_incomplete', choices => [ { val => 1, default => $TRUE, label => 'Excl. results which are incomplete
Play-by-play is mostly complete to 1954 and entirely complete to 1974. Pitch-by-pitch, count data, and hit location is very complete back to 1988. Coverage Details' } ] }; cache_set( 'split_finder:select', $key, $return ); _display_correct_split_select_box( $return->{subfields}, $split_selected ); return $return; } sub _display_correct_split_select_box { my ( $subfields, $split_selected ) = @_; for my $subfield (@$subfields) { $subfield->{toggleopen} = $TRUE if $subfield->{name} eq "sid_$split_selected"; } }