#!/usr/bin/perl #-############################################# # Carded Minors calculator for USBL # Rob McQuown - robmcquown@yahoo.com, # modified from the original, which was used by permission # Version 0.1 - 2/1/2007 #-############################################# use vars qw(%config %category %level %mult %league_max %form); use strict; use Time::Local; use Cwd; use Fcntl qw/:flock/; #-############################################# # Configuration Section # Edit these variables! local %config; $config{'version'}="0.1"; # Salary minimums by year use [year] to determine (see constitution) our @minimums = (500000,750000,1250000,2000000,3500000,5000000); # The Base Directory. We need an # absolute path for the base directory. # Include the trailing slash. THIS SHOULD # NOT BE WEB-ACCESSIBLE! $config{'basepath'} = '/home/virtual/site503/var/www/perl/CML/'; # $config{'basepath'} = 'C:/Perl/usbl/auction/'; # temp $config{'max_days'} = '30'; $config{'motd'}="Send comments to robmcquown\@yahoo.com"; # Closed Auction Directory # This is where closed auction items are stored. # Leave this blank if you don't want to store # closed auctions. It can potentially take # up quite a bit of disk space. $config{'closedir'} = 'closed'; # User Registration Directory # This is where user registrations are stored. # Leave this blank if you don't want to # require registration. It can potentially # take up quite a bit of disk space. $config{'regdir'} = 'reg'; # List each directory and its associated # category name. These directories should # be subdirectories of the base directory. %category = ( pitchers => 'Pitchers', catchers => 'Catchers', firstbasemen => 'First Basemen', secondbasemen => 'Second Basemen', thirdbasemen => 'Third Basemen', shortstops => 'Shortstops', outfielders => 'Outfielders', ); %level = ( 1 => 'A', 2 => 'AA', 3 => 'AAA', 4 => 'MLB', ); %mult = ( 1 => 0.5, 2 => 0.65, 3 => 0.8, 4 => 1.0, ); # This is the password for deleting auction # items. $config{'adminpass'} = 'marietla'; # You need to assign either a mail program or # a mail host so confirmation e-mails can # be sent out. # Leave one commented and one uncommented. # # YOU NEED EITHER A MAIL PROGRAM $config{'mailprog'} = '/home/virtual/site503/usr/sbin/sendmail -t'; # # OR YOU NEED A MAIL HOST (SMTP) #$config{'mailhost'} = 'smtp.1and1.com'; # This line should be your e-mail address #$config{'admin_address'} = 'midlanddog@chartermi.net'; $config{'admin_address'} = 'robmcquown@yahoo.com'; # This line should point to the URL of # your server. It will be used for sending # "you have been outbid" e-mail. The script # name and auction will be appended to the # end automatically, so DO NOT use a trailing # slash. If you do not want to send outbid # e-mail, leave this blank. $config{'scripturl'} = 'www.the-usbl.org'; # This will let you define colors for the # tables that are generated and the # other page colors. The default colors # create a nice "professional" look. Must # be in hex format. $config{'colortablehead'} = '#BBBBBB'; $config{'colortablebody'} = '#EEEEEE'; # Site Name (will appear at the top of each page) $config{'sitename'} = 'USBL'; # You can configure your own header which will # be appended to the top of each page. $config{'header'} =<<"EOF"; $config{'sitename'} - USBL
$config{'sitename'}
Carded Minor Leaguer Calculator (ALPHA TEST version $config{'version'})

EOF # You can configure your own footer which will # be appended to the bottom of each page. # Although not required, a link back to # everysoft.com will help to support future # development. $config{'footer'} =<<"EOF";

Powered By Ultimate Strat-O-Matic Baseball League
EOF # Sniper Protection... How many minutes # past last bid to hold auction. If auctions # should close at exactly closing time, set # to zero. $config{'aftermin'} = 10; # File locking enabled? Should be 1 (yes) # for most systems, but set to 0 (no) if you # are getting flock errors or the script # crashes. $config{'flock'} = 1; # User Posting Enabled- 1=yes 0=no $config{'newokay'} = 1; # User View Money available - 1=yes 0=no $config{'moneyokay'} = 1; #-############################################# # Main Program # You do not need to edit anything below this # line. #-############################################# # Print The Page Header # print "Content-type: text/html\n\n"; print $config{'header'}; local %form = &get_form_data; if ($form{'action'} eq 'calcpit') { &calcpit; } elsif ($form{'action'} eq 'calcbat') { &calcbat; } else { &mainform; } #-############################################# # Print The Page Footer # #print "

[Category List]"; #print " [Post New Item]" if ($config{'newokay'}); #print " [Show Money Available]" if ($config{'moneyokay'}); #print " [New Registration] [Change Registration]" if ($config{'regdir'}); #print " [Closed Auctions]" if ($config{'regdir'}) and ($config{'closedir'}); #print "[ALL Players]"; #print "

\n"; print $config{'footer'}; # #-############################################# #-############################################# # Sub: Get Form Data # This gets data from a post. sub get_form_data { my $temp; my $buffer; my @data; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); foreach $temp (split(/&|=/,$buffer)) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } foreach $temp (split(/&|=/,$ENV{'QUERY_STRING'})) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } return @data; } #-############################################# # Sub: carded_batters_max # Loads the constants into league_max{} sub carded_batters_max { &oops('unable to open allfile.') unless (open ALLFILE, "$config{'basepath'}carded_batters.csv"); while () { my @allnums=split /\t/,$_; my $pos=@allnums[0]; $pos=~ s/"//g; $league_max{$pos}=[ @allnums ]; } close ALLFILE; # print "of3:",$league_max{'Outfielders'}[3],"\n"; } #-############################################# # Sub: One Row Output only # sub subform_bat_out { my ($n,$ab,$h,$do,$tr,$hr,$rbi,$sb,$cs,$bb,$ibb,$so,$sh,$sf,$hbp) = @_; my $x =""; $x.=""; $x.="$n"; $x.="$ab"; $x.="$h"; $x.="$do"; $x.="$tr"; $x.="$hr"; $x.="$rbi"; $x.="$sb"; $x.="$cs"; $x.="$bb"; $x.="$ibb"; $x.="$so"; $x.="$sh"; $x.="$sf"; $x.="$hbp"; $x.="\n"; return $x; } #-############################################# # Sub: One Row Output only - "extra" stats # sub subform_bat2_out { my ($n,$avg,$obp,$slg,$tr,$hr,$rbi,$sb,$cs,$bb,$ibb,$so,$sh,$sf,$hbp) = @_; $avg= sprintf("%.03f",$avg); $obp= sprintf("%.03f",$obp); $slg= sprintf("%.03f",$slg); my $x =""; $x.=""; $x.="$n"; $x.="$avg"; $x.="$obp"; $x.="$slg"; $x.="$tr"; $x.="$hr"; $x.="$rbi"; $x.="$sb"; $x.="$cs"; $x.="$bb"; $x.="$ibb"; $x.="$so"; $x.="$sh"; $x.="$sf"; $x.="$hbp"; $x.="\n"; return $x; } #-############################################# # Sub: One Row Output only - pitchers # sub subform_pit_out { my ($n,$w,$l,$gs,$sv,$ip,$ph,$phr,$er,$pbb,$pso,$wp,$bk,$era) = @_; $era= sprintf("%.02f",$era); my $x =""; $x.=""; $x.="$n"; $x.="$w"; $x.="$l"; $x.="$gs"; $x.="$sv"; $x.="$ip"; $x.="$ph"; $x.="$phr"; $x.="$er"; $x.="$pbb"; $x.="$pso"; $x.="$wp"; $x.="$bk"; $x.="$era"; $x.="\n"; return $x; } #-############################################# # Sub: One Row Output only - "extra" stats pitchers # sub subform_pit2_out { my ($n,$avg,$obp,$slg,$tr,$hr,$rbi,$sb,$cs,$bb,$ibb,$so,$sh,$sf,$hbp) = @_; my $x =""; $x.=""; $x.="$n"; $x.="$avg"; $x.="$obp"; $x.="$slg"; $x.="$tr"; $x.="$hr"; $x.="$rbi"; $x.="$sb"; $x.="$cs"; $x.="$bb"; $x.="$ibb"; $x.="$so"; $x.="$sh"; $x.="$sf"; $x.="$hbp"; $x.="\n"; return $x; } #-############################################# # Sub: One Row # sub subform_bat { my $n = shift; my $x =""; my $v =""; $x.=""; $x.="$level{$n}"; $v=$form{"AB$n"}; $x.=""; $v=$form{"H$n"}; $x.=""; $v=$form{"DO$n"}; $x.=""; $v=$form{"TR$n"}; $x.=""; $v=$form{"HR$n"}; $x.=""; $v=$form{"RBI$n"}; $x.=""; $v=$form{"SB$n"}; $x.=""; $v=$form{"CS$n"}; $x.=""; $v=$form{"BB$n"}; $x.=""; $v=$form{"IBB$n"}; $x.=""; $v=$form{"SO$n"}; $x.=""; $v=$form{"SH$n"}; $x.=""; $v=$form{"SF$n"}; $x.=""; $v=$form{"HBP$n"}; $x.=""; $x.="\n"; return $x; } #-############################################# # Sub: One Row # sub subform_pit { my $n = shift; my $x =""; my $v =""; $x.=""; $x.="$level{$n}"; $v=$form{"W$n"}; $x.=""; $v=$form{"L$n"}; $x.=""; $v=$form{"GS$n"}; $x.=""; $v=$form{"SV$n"}; $x.=""; $v=$form{"IP$n"}; $x.=""; $v=$form{"PH$n"}; $x.=""; $v=$form{"PHR$n"}; $x.=""; $v=$form{"ER$n"}; $x.=""; $v=$form{"PBB$n"}; $x.=""; $v=$form{"PSO$n"}; $x.=""; $v=$form{"WP$n"}; $x.=""; $v=$form{"BK$n"}; $x.=""; $v=sprintf("%.02f",9.0*$form{"ER$n"}/$form{"IP$n"}) if ($form{"IP$n"}>0); $x.="$v"; $x.="\n"; return $x; } #-############################################# # Sub: Header row of batters table. # sub subform_bat_top { my $n = shift; my $x =""; $x.=""; $x.="$n"; $x.="AB"; $x.="H"; $x.="2B"; $x.="3B"; $x.="HR"; $x.="RBI"; $x.="SB"; $x.="CS"; $x.="BB"; $x.="IBB"; $x.="SO"; $x.="SH"; $x.="SF"; $x.="HBP"; $x.="\n"; return $x; } #-############################################# # Sub: Header row of batters table. # "extra" stats # sub subform_bat2_top { my $n = shift; my $x =""; $x.=""; $x.="$n"; $x.="Avg"; $x.="OBP"; $x.="Slg"; $x.="Pct vs L"; $x.="Bunt"; $x.="H and R"; $x.="Run"; $x.="Steal"; $x.="Asterisk"; $x.="Lead"; $x.="1st Sup"; $x.="2nd Sup"; $x.="Bats"; $x.="Pos"; $x.="\n"; return $x; } #-############################################# # Sub: Header row of pitchers table. # sub subform_pit_top { my $n = shift; my $x =""; $x.=""; $x.="$n"; $x.="W"; $x.="L"; $x.="GS"; $x.="SV"; $x.="IP"; $x.="H"; $x.="HR"; $x.="ER"; $x.="BB"; $x.="K"; $x.="WP"; $x.="BK"; $x.="ERA"; $x.="\n"; return $x; } #-############################################# # Sub: Header row of pitchers table. # "extra" stats # sub subform_pit2_top { my $n = shift; my $x =""; $x.=""; $x.="$n"; $x.="Throws"; $x.="Pct vs L"; $x.="End"; $x.="Hold"; $x.="Field"; $x.="Bat"; $x.="Bunt"; $x.="H and R"; $x.="Steal"; $x.="Run"; $x.="\n"; return $x; } #-############################################# # Sub: Main Form Batters # sub mainform_bat { my $x=""; $x.="
"; $x.="

Calculate Carded Minor League Batter

"; $x.=""; $x.=""; $x.=subform_bat_top('Level'); print $x; print subform_bat(1); print subform_bat(2); print subform_bat(3); print subform_bat(4); print "
"; print "Position: "; print "Batting Side:
"; print "
"; print "
"; } #-############################################# # Sub: Main Form Pitchers # sub mainform_pit { my $x=""; # print "mainform_pit
"; $x.="
"; $x.="

Calculate Carded Minor League Pitcher

"; $x.=""; $x.=""; $x.=subform_pit_top('Level'); print $x; print subform_pit(1); print subform_pit(2); print subform_pit(3); print subform_pit(4); print "
"; print "Throwing Hand:
"; print "
"; print "
"; } #-############################################# # Sub: mainform # sub mainform { &mainform_bat; &mainform_pit; } #-############################################# # Sub: calcbat # sub calcbat { my ($ab,$h,$do,$tr,$hr,$rbi,$sb,$cs,$bb,$ibb,$so,$sh,$sf,$hbp); &carded_batters_max; $ab=$form{'AB1'}+$form{'AB2'}+$form{'AB3'}+$form{'AB4'}; $h=addfour(0,$form{'H1'},$form{'H2'},$form{'H3'},$form{'H4'}); $do=addfour(0,$form{'DO1'},$form{'DO2'},$form{'DO3'},$form{'DO4'}); $tr=addfour(0,$form{'TR1'},$form{'TR2'},$form{'TR3'},$form{'TR4'}); $hr=addfour(0,$form{'HR1'},$form{'HR2'},$form{'HR3'},$form{'HR4'}); $rbi=addfour(0,$form{'RBI1'},$form{'RBI2'},$form{'RBI3'},$form{'RBI4'}); $sb=addfour(0,$form{'SB1'},$form{'SB2'},$form{'SB3'},$form{'SB4'}); $cs=addfour(1,$form{'CS1'},$form{'CS2'},$form{'CS3'},$form{'CS4'}); $bb=addfour(0,$form{'BB1'},$form{'BB2'},$form{'BB3'},$form{'BB4'}); $ibb=addfour(0,$form{'IBB1'},$form{'IBB2'},$form{'IBB3'},$form{'IBB4'}); $so=addfour(1,$form{'SO1'},$form{'SO2'},$form{'SO3'},$form{'SO4'}); $sh=$form{'SH1'}+$form{'SH2'}+$form{'SH3'}+$form{'SH4'}; $sf=$form{'SF1'}+$form{'SF2'}+$form{'SF3'}+$form{'SF4'}; $hbp=$form{'HBP1'}+$form{'HBP2'}+$form{'HBP3'}+$form{'HBP4'}; # Create table x for basic stats. my $x=""; # $x.="
"; # $x.=""; $x.=""; $x.=subform_bat_top('Adjusted'); $x.="\n"; $x.=subform_bat_out('Adjusted',$ab,$h,$do,$tr,$hr,$rbi,$sb,$cs,$bb,$ibb,$so,$sh,$sf,$hbp); $form{'POS'}='firstbasemen' if (!$form{'POS'}); $h=adjminmax(0,$ab,$h/$ab,$league_max{$form{'POS'}}[1]); $do=adjminmax(0,$ab,$do/$ab,$league_max{$form{'POS'}}[2]); $tr=adjminmax(0,$ab,$tr/$ab,$league_max{$form{'POS'}}[3]); $hr=adjminmax(0,$ab,$hr/$ab,$league_max{$form{'POS'}}[4]); $rbi=adjminmax(0,$ab,$rbi/$ab,$league_max{$form{'POS'}}[5]); $bb=adjminmax(0,$ab,$bb/$ab,$league_max{$form{'POS'}}[8]); $so=adjminmax(1,$ab,$so/$ab,$league_max{$form{'POS'}}[9]); $x.="\n"; $x.=subform_bat_out('USBL',$ab,$h,$do,$tr,$hr,$rbi,$sb,$cs,$bb,$ibb,$so,$sh,$sf,$hbp); $x.="
"; # Create table x2 to display "extra" stats. my $x2=""; $x2.=""; $x2.=subform_bat2_top('Extra Stats'); $x2.="\n"; my $pct=($form{'BATS'} eq 'R')?70:(($form{'BATS'} eq 'L')?30:50); $x2.=subform_bat2_out('Adjusted',$h/$ab,($h+$bb+$hbp)/($ab+$bb+$hbp+$sf),($h+$do+$tr*2+$hr*3)/$ab,$pct, $sh<4?'D':'C','D',$sb>=25?15:($sb>=10?14:($sb>=5?12:10)),'D','N','??','??','??',$form{'BATS'},$form{'POS'}); $x2.="
"; print "

USBL Stats

"; print $x; print $x2; &mainform; } #-############################################# # Sub: calcpit # sub calcpit { my ($w,$l,$gs,$sv,$ip,$ph,$phr,$er,$pbb,$pso,$wp,$bk,$era); $w=addfour(0,$form{'W1'},$form{'W2'},$form{'W3'},$form{'W4'}); $l=addfour(1,$form{'L1'},$form{'L2'},$form{'L3'},$form{'L4'}); $gs=$form{'GS1'}+$form{'GS2'}+$form{'GS3'}+$form{'GS4'}; $sv=addfour(0,$form{'SV1'},$form{'SV2'},$form{'SV3'},$form{'SV4'}); $ip=$form{'IP1'}+$form{'IP2'}+$form{'IP3'}+$form{'IP4'}; $ph=addfour(1,$form{'PH1'},$form{'PH2'},$form{'PH3'},$form{'PH4'}); $phr=addfour(1,$form{'PHR1'},$form{'PHR2'},$form{'PHR3'},$form{'PHR4'}); $er=addfour(1,$form{'ER1'},$form{'ER2'},$form{'ER3'},$form{'ER4'}); $pbb=addfour(1,$form{'PBB1'},$form{'PBB2'},$form{'PBB3'},$form{'PBB4'}); $pso=addfour(0,$form{'PSO1'},$form{'PSO2'},$form{'PSO3'},$form{'PSO4'}); $wp=addfour(0,$form{'WP1'},$form{'WP2'},$form{'WP3'},$form{'WP4'}); $bk=addfour(1,$form{'BK1'},$form{'BK2'},$form{'BK3'},$form{'BK4'}); # Create table x for basic stats. my $x=""; # $x.=""; # $x.=""; $x.=""; $x.=subform_pit_top('Adjusted'); $x.="\n"; # $era=($ph/$ip*9*.344)+($pbb/$ip*9*.31)+(.793*9*$phr/$ip)-(0.094*9*$pso/$ip); $era=($ph/$ip*9*.575)+($pbb/$ip*9*.28)+(.94*9*$phr/$ip)-(0.01*9*$pso/$ip)-2.77; $x.=subform_pit_out('Adjusted',$w,$l,$gs,$sv,$ip,$ph,$phr,$er,$pbb,$pso,$wp,$bk,$era); $ph=adjminmax(1,$ip,$ph/$ip,1.22585509056364); $phr=adjminmax(1,$ip,$phr/$ip,0.146483604769502); $pbb=adjminmax(1,$ip,$pbb/$ip,0.430992514812903); $pso=adjminmax(0,$ip,$pso/$ip,0.622017837492949); $x.="\n"; $era=($ph/$ip*9*.575)+($pbb/$ip*9*.28)+(.94*9*$phr/$ip)-(0.01*9*$pso/$ip)-2.77; $x.=subform_pit_out('USBL',$w,$l,$gs,$sv,$ip,$ph,$phr,$er,$pbb,$pso,$wp,$bk,$era); $x.="
"; # Create table x2 to display "extra" stats. my $x2=""; $x2.=""; $x2.=subform_pit2_top('Extra Stats'); $x2.="\n"; $x2.=subform_pit2_out('Adjusted',$form{'THROWS'},50,'5/2/N','+2','4e51','1','C','D','E','10'); $x2.="
"; print "

USBL Stats

"; print $x; print $x2; &mainform; } #-############################################# # Sub: Oops! # This generates an error message and dies. sub oops { print "


Error:
$_[0]

Please hit the back browser on your browser to try again or contact the auction administrator if you believe this to be a server problem.


\n"; print $config{'footer'}; # die "Error: $_[0]\n"; exit; } #-############################################# # Sub: parse bid # This formats a bid amount to look good... # ie. $###.## sub parsebid { $_[0] =~ s/\,|\$//g; my @bidamt = split(/\./, $_[0]); $bidamt[0] = "0" if (!($bidamt[0])); # $bidamt[0] = commify(int($bidamt[0])); $bidamt[0] = sprintf("%.0f",$bidamt[0]); $bidamt[1] = substr($bidamt[1], 0, 1); $bidamt[1] = "0" if (length($bidamt[1]) == 0); # return "$bidamt[0].$bidamt[1]"; return "$bidamt[0]"; } #-############################################# # Sub: addfour # adds numbers from A,AA,AAA,MLB sub addfour { my ($updown,$n1,$n2,$n3,$n4)=@_; my $n=0; if ($updown) { $n+=int($n1/$mult{1}+.9999); $n+=int($n2/$mult{2}+.9999); $n+=int($n3/$mult{3}+.9999); $n+=int($n4/$mult{4}+.9999); } else { $n+=int($n1*$mult{1}); $n+=int($n2*$mult{2}); $n+=int($n3*$mult{3}); $n+=int($n4*$mult{4}); } return $n; } #-############################################# # Sub: adjminmax # first parm:0 to take lowest, 1 for highest. sub adjminmax { my ($updown,$ab,$n1,$n2)=@_; my $n=0; if ($updown) { $n=int(($n1>$n2?$n1:$n2)*$ab+.9999); } else { $n=int(($n1>$n2?$n2:$n1)*$ab); } return $n; }