use Perl; Guide to references: Part 5

This is the final part in my five part guide to Perl references. It's a complete program that contains a menu system along with the card game 'war'. This is pretty serious spaghetti code, so I will likely replace it as soon as I come up with something that uses all of the examples in this series but has a more logical flow and is easier on the eyes :)

• Part 1 - The basics
• Part 2 - References as subroutine parameters
• Part 3 - Nested data structures
• Part 4 - Code references
• Part 5 - Concepts put to use (this document)

Please leave any corrections, criticisms, improvements, additions, questions and requests for further clarity in the comments section below, or in an email.

The following program code can be copy/pasted without all of the comments from my scripts repository.

#!/usr/bin/perl

use warnings;
use strict;
use 5.10.0;

# create a master dispatch table, using a reference to an
# external sub, and two inline subs

my %dispatch_table = (
                        play    => \&play_game,
                        hello   => sub { say "\nHello, world!\n"; },
                        'exit'  => sub { say "\nGoodbye!\n"; exit; },
                    );

# create an href to the dispatch table hash

my $dt_ref = \%dispatch_table;

# take a reference to the closure within the games_played() sub

my $games_played = games_played();

# loop over the menu until the user exits

while ( 1 ){

    system( "clear" );

    # get the dispatch table options by dereferencing the
    # dispatch table href

    my @options = keys %{ $dt_ref };

    say "Enter one of these options: " . join( ' ', @options );
    chomp ( my $command = <STDIN> );

    # exit if an illegal option was entered by the user

    exit if ! exists $dt_ref->{ $command };
    
    # otherwise, execute the sub the user selected

    $dt_ref->{ $command }->();

    # check to see if any games have been played through
    # the $games_played closure cref

    if ( $games_played->() ){
        say "You've played " . $games_played->() . " games.\n";
    }

    print "Please press ENTER...";
    <STDIN>;
}
sub play_game {

    # this is the main game sub, called through the dispatch
    # table

    system( "clear" );

    # create a deck of cards using a hash, and assign
    # a numeric value to the face value key

    my %deck;
    my $card_value = 14;

    for ( qw( A K Q J ), ( reverse 2..10 ) ){

        $deck{ $_ } = $card_value;
        $card_value--;
    }

    # a list of the card faces (without their numeric values)
 
    my @cards = keys %deck;

    print "Enter your name: ";
    chomp ( my $player = <STDIN> );

    print "Enter number of rounds (default: 5): ";
    chomp ( my $rounds = <STDIN> );
    $rounds = 5 if $rounds !~ /\d+/;

    # create a nested HoH for the players, using an href as
    # the top level

    my $players = { 
                    $player => {
                                score    => 0,
                                card     => undef,
                            },
                    npc      => {
                                score    => 0, 
                                card     => undef,
                            },
                    };

    my @player_names = keys %{ $players };

    for my $round ( 1 .. $rounds ){

        print "Round $round: ";

        for my $player ( @player_names ){

            # call deal(), passing in an aref of the cards array

            my $card = deal( \@cards );
            print "$player $card   ";

            # set the players current card in their card slot in the
            # players HoH

            $players->{ $player }{ card } = $card;
        }

        # call the compare_hands() sub by passing in an anonymous
        # hash (reference) inline in the call, with three parameters.
        # All three values are references

        compare_hands({ 
                        player_names => \@player_names,
                        players      => $players,
                        deck         => \%deck,
                     });

        print "\n";
    }

    print "\n";

    # loop over players, and get each of their final
    # scores out of the players HOH

    for my $player ( @player_names ){

        my $score = $players->{ $player }{ score };
        say "$player won $score rounds.";
    }

    print "\n";

    # update games played

    $games_played->( 1 );
}
sub deal {

    # take an aref of @cards, and return a random one

    my $deck_of_cards = shift; # aref
    return $deck_of_cards->[ rand @{ $deck_of_cards } ];
}
sub compare_hands {

    my $named_params = shift;
    
    # separate out the data from the named parameters
    # in the href we got passed in

    my $player_names    = $named_params->{ player_names };
    my $players         = $named_params->{ players };
    
    # we convert the last named param back into a hash
    # by dereferencing it

    my %deck            = %{ $named_params->{ deck } };

    my ( $player1, $player2 ) = @{ $player_names };

    # get each player's card

    my $p1_card = $players->{ $player1 }{ card };
    my $p2_card = $players->{ $player2 }{ card };

    # check the face of the card to the %deck hash to
    # retrieve the numerical value

    my $p1_card_val = $deck{ $p1_card };
    my $p2_card_val = $deck{ $p2_card };

    # nobody wins this round... its a tie

    return if $p1_card_val == $p2_card_val;

    if ( $p1_card_val > $p2_card_val ){
        # player 1 wins
        $players->{ $player1 }{ score }++;
    }
    else {
        # player 2 wins
        $players->{ $player2 }{ score }++;
    }
}    
sub games_played {
    
    # state data

    my $games_played = 0;

    # our games_played closure

    return sub {
                my $add = shift;
                $games_played += $add if $add;
                return $games_played;
               }
}

Thank you very much for reading. I have received a lot of great feedback on the series, both from people informing me they have learnt a great deal, and others with corrections and additions. I appreciate you all. I hope you have enjoyed my Guide to reference tutorials. Please feel free to provide me feedback so I may improve on my style for future posts.

Regards and thanks,

-stevieb