#!/usr/bin/perl  -w

# Program: poker.pl
# Copyright 2009 Peter Eschright, petereschright@gmail.com

use strict;

my ($help, $r, $s, %card_names, %pl_card_names, %suit_names); #not modified
my ($hand, $suits, $ranks, $flush, $straight, $high_card); #variables

# usage info:
$help = <<__HELP__;
**poker.pl**
A Perl script to rank poker hands.
Copyright 2009 Peter Eschright, petereschright\@gmail.com
Usage:
   >poker.pl hand_string
Where \'hand_string\' is 5 comma seperated rank suit pairs.
A rank specifier, which is one of:
   AKQJT98765432
Followed by a suit specifier:
   [C]lubs [D]iamonds [H]earts [S]pades
Duplicate cards are not allowed, and the string is case sensitive.
Example input:
   TH,6S,TS,6C,AD
Output is the hand category then rank (if not implied) in plain English.
Example output:
   Two Pair, Tens and Eights
__HELP__

$r = 'AKQJT98765432'; #valid rank specifiers
$s = 'CDHS'; #valid suit specifiers

%card_names = ('A' => 'Ace', 'K' => 'King', 'Q' => 'Queen', 'J' => 'Jack',
   'T' => 'Ten', '9' => 'Nine', '8' => 'Eight', '7' => 'Seven', '6' => 'Six',
   '5' => 'Five', '4' => 'Four', '3' => 'Three', '2' => 'Two');

%pl_card_names = ('A' => 'Aces', 'K' => 'Kings', 'Q' => 'Queens',
   'J' => 'Jacks', 'T' => 'Tens', '9' => 'Nines', '8' => 'Eights',
   '7' => 'Sevens', '6' => 'Sixes', '5' => 'Fives', '4' => 'Fours',
   '3' => 'Threes', '2' => 'Twos');

%suit_names = ('C' => 'Clubs', 'D' => 'Diamonds', 'H' => 'Hearts',
   'S' => 'Spades');

# read in arguments
$hand = $ARGV[0] or print "Error: usage! try: >poker.pl help\n" and exit;
print "$help\n" and exit if $hand =~ /^-?h(?:elp)?$/i;

# verify hand format:
print "Invalid hand format! try: >poker.pl help\n" and exit
   if ($hand !~ /^(?:[$r][$s],){4}[$r][$s]$/);
print "Invalid hand format! Duplicate cards, try >poker.pl help\n" and exit
   if ($hand =~ /([$r][$s]).*\1/);

# arrange cards
$hand =~ tr/AKQJT98765432/abcdefghijklm/;
$hand = join(',',sort(split(',',$hand)));
$hand =~ tr/abcdefghijklm/AKQJT98765432/;

# do preliminary work
$suits = $hand and $suits =~ s/[$r,]//g; #make list of card suits
$ranks = $hand and $ranks =~ s/[$s,]//g; #make list of card ranks
$flush = ($suits =~ /^([$s])\1{4}/); #look for flush
$straight = ("${r}A5432" =~ /$ranks/); #look for straight
$high_card = $1 if $ranks =~ /^([$r])/; #set high card

# display hand type
print "Royal Flush\n" and exit 
   if $flush and $straight and ($hand =~ /^A/);
print "Straight Flush, to the $card_names{$high_card}\n" and exit 
   if $flush and $straight;
print "Four of a Kind, $pl_card_names{$1}\n" and exit
   if $ranks =~ /([$r])\1{3}/;
print "Full House, $pl_card_names{$1} full of $pl_card_names{$2}\n" and exit
   if $ranks =~ /([$r])\1{2}([$r])\2/;
print "Full House, $pl_card_names{$2} full of $pl_card_names{$1}\n" and exit
   if $ranks =~ /([$r])\1([$r])\2{2}/;
print "Flush, $card_names{$high_card} High\n" and exit
   if $flush;
print "Straight, to the $card_names{$high_card}\n" and exit 
   if $straight;
print "Three of a Kind, $pl_card_names{$1}\n" and exit
   if $ranks =~ /([$r])\1{2}/;
print "Two Pairs, $pl_card_names{$1} and $pl_card_names{$2}\n" and exit
   if $ranks =~ /([$r])\1[$r]?([$r])\2/;
print "Pair of $pl_card_names{$1}\n" and exit 
   if $ranks =~ /([$r])\1/;
print "$card_names{$high_card} High\n"; # by default
   
# done