In the past few articles we have only touched the surface of OO programming in Perl by building a relatively simple class. This series has not been intended to teach OO programming per se, but rather to introduce the topic with a working example and provide a starting point for those wishing to delve further.

In particular, out of the following general OO concepts: Abstraction, Encapsulation, Inheritance, and Polymorphism, we have only really addressed encapsulation — hiding the internal workings and data inside the object and providing an external interface to the programmer. Abstraction is just generalization. Our slot class was not very abstract because we hard coded in the wheels and payoff table — a more abstract slot machine class might be defined so that a variety of slot machines and payoff tables could be used.

Inheritance and Polymorphism define relationships among classes — one class might be very general and not really intended to be used directly. Other classes can then be defined as derived or child classes of the this class and they can inherit all of the properties and methods of their parent class. Often when inheriting from a parent class, the new class needs to change or override one or more methods — this is referred to as polymorphism (child classes need not be identical to their parents, nor to their siblings).

There is a great deal of further information that can be found in the standard Perl documentation:

    perldoc perltoot     # an OO primer
    perldoc perlboot     # another OO primer
    perldoc perltootc    # a tutorial on class data
    perldoc perlobj      # the manpage for Perl objects
    perldoc perlbot      # OO tips and tricks

As well, Damian Conway has written and excellent book on the subject of OO programming with Perl:

    Object Oriented Perl. By Damian Conway (Manning Publications)

This book is widely recognized by many in the Perl community to be the bible of OO programming in Perl. It is very readable, highly informative, and even funny. I definitely recommend it for anyone who wants to learn how to do OO programming in Perl.

*****

The spin() method is the most complex as it does all the real work of simulating the slot machine (the object itself just stores the current state of the machine and ancillary data). The first thing we will need to do is figure out how much is being bet on this spin:

    sub spin {
        my $self = shift;
        my $bet  = $self->bet(shift);
        $bet = < $bet < 3? $bet : 3;
        $bet = $bet < $self->credits()? $bet : $self->credits();

We obtain the $bet value by calling the bet() method with the second argument (if any). We then check that the bet doesn’t exceed 3, and finally check that it doesn’t exceed our remaining credits. Next we get the spin result itself:

        my $spin = join('', map{$symbols[rand @symbols]}1..3);
        $self->{spin} = $spin;

Here we have used map() to create a list of three random elements from the @symbols array and joined them into a single string, and we set the ‘spin’ attribute of the object. Next we need to calculate the payoff for this spin:

        my $payoff = 0;
        if($spin =~ /^(\d)\1\1$/){
            $payoff = $payoff{$spin}->($bet);
        } elsif ($spin =~ /^[123][123][123]$/) {
            $payoff = $payoff{any}->($bet);
        }

Here we first check if the spin contains three matching digits (using a regex), and if so we call the subroutine from the %payoff hash to obtain the payoff for that spin. The special case of ‘any’ is taken care of by the elsif clause. Lastly, we need to adjust the attributes:

        $self->{credits} -= $bet;
        $self->{credits} += $payoff;
        $self->{paid}     = $payoff;
        $self->{win}      = $payoff;
    }

We first subtract the $bet amount from the credits, then add any payoff (we could have done this in one step). Then we set the ‘paid’ attribute to equal the current payoff, and finally, we set the ‘win’ attribute to the payoff as well. Why? if the payoff is zero, then the win will be false, if there is a payoff, then the value will be true. So, rather than setting it to 0 or 1, we simply set it to the payoff itself.

Now we have a complete object oriented slot module. The complete module is:

    package Slot;
    use strict;
    my %payoff = (
        "777"  => sub {$_[0] * 500},
        "333"  => sub {$_[0] * 80},
        "222"  => sub {$_[0] * 20},
        "111"  => sub {$_[0] * 5},
        "any"  => sub {$_[0] * 2},
        "000"  => sub {$_[0] * 1},
        );

    my @symbols = (0,7,0,3,0,2,0,1);

    sub new {
        my $class   = shift;
        my $credits = shift || 100;
        my $self  = {credits => $credits,
                     bet     => 1,
                     win     => 0,
                     paid    => 0,
                     spin    => undef,
                    };
        bless $self, $class;
    }

    sub credits {
        my $self = shift;
        $self->{credits};
    }
    sub bet {
        my $self = shift;
        $self->{bet} = shift||$self->{bet};
    }

    sub spin {
        my $self = shift;
        my $bet  = $self->bet(shift);
        $bet = $bet < 3? $bet : 3;
        $bet = $bet < $self->credits()? $bet : $self->credits();
        my $spin = join('', map{$symbols[rand @symbols]}1..3);
        $self->{spin} = $spin;
        my $payoff = 0;
        if($spin =~ /^(\d)\1\1$/){
            $payoff = $payoff{$spin}->($bet);
        } elsif ($spin =~ /^[123][123][123]$/) {
            $payoff = $payoff{any}->($bet);
        }
        $self->{credits} -= $bet;
        $self->{credits} += $payoff;
        $self->{paid}     = $payoff;
        $self->{win}      = $payoff;
    }

    sub display_results {
        my $self = shift;
        print join(" ", split //, $self->{spin}),"\n";
        if ($self->{win}){
            print "Winner paid: $self->{paid} credits!!\n\n";
        } else {
            print "Better luck next time\n\n";
        }

    }
    1;
    __END__

And the interactive test script is:

    #!/usr/bin/perl -w
    use strict;
    use Slot;
    my $slot = Slot->new(100);
    while(1){
        my $credits  = $slot->credits();
        my $curr_bet = $slot->bet();
        last if $credits < 1;

        print "You have $credits remaining: max bet is 3\n";
        print "Enter your bet [$curr_bet]: ";

        chomp(my $bet = <STDIN>);
        last if $bet eq 'q';
        $bet ||= $curr_bet;

        $slot->spin($bet);
        $slot->display_results();
    }

    print "Game Over\n";
    print "You have ", $slot->credits(), " remaining\n";
    print "Thank you for playing\n";
    __END__

I have played a few times and always seem to lose my credits in a short time — so I guess it’s just like the real thing :-)

At this point in the object tutorial we have built a Slot class that builds a simple object with a few attributes and provides a couple of accessor routines for those attributes the user might need. But we don’t have working slot machine by any means.

Our slot machine will be a variation on the lucky-7 variety — it will have 3 spinning wheels each containing the following digits: 0,1,2,3,7. Getting three 7’s will pay the most, followed by three 3’s, three 2’s, three 1’s, three of any 1,2 or 3, and three 0’s.

The payoff scheme will be as follows (I don’t have much experience slot machines and odds, so I’m making this up as I go along — feel free to change things in your machine) [$bet indicates amount being bet]:

    777   pays  $bet * 500
    333   pays  $bet * 80
    222   pays  $bet * 20
    111   pays  $bet * 5
    any   pays  $bet * 2
    000   pays  $bet * 1

Here, "any" refers to spins with all wheels showing any of 1,2, or 3 (for example: 123, 332, 231). We can set this up as a hash of payoffs where the keys will be the spin result and the values will be anonymous subroutines that return the winnings:

    my %payoff = (
        "777"  => sub {$_[0] * 500},
        "333"  => sub {$_[0] * 80},
        "222"  => sub {$_[0] * 20},
        "111"  => sub {$_[0] * 5},
        "any"  => sub {$_[0] * 2},
        "000"  => sub {$_[0] * 1},
        );

This will only be accessed within our module, not by the user. We will call it like:

    $payoff = $payoff{$spin}->($bet);

But we’ll get to that shortly. So we have payoffs, but we still don’t have a machine. One very simple way to simulate this machine is with a single array containing all the digits. We can then just choose three random elements from that array and we’ll have our spin result:

    my @symbols = (0,7,0,3,0,2,0,1);

I’ve thrown in extra 0’s to make it more likely to appear (you can adjust the symbols list to better approximate a real slot machine’s probabilities if you know them).

Both the %payoff hash and the @symbols array are called class data. They are not stored with each object but only in the class, and all object methods can access them.

We still have two methods left to define: spin() and results(), according to our original specification and test program. The spin() method is the most complex and we will have to leave it to next week. But we can make an assumption about it: after spin() is called, all of the attributes will be set appropriately. That is, the credits attribute will be adjusted, the ‘win’ attribute will be set to 1 if it is a winning spin, and the ‘paid’ attribute will contain the payoff for that spin. The ‘spin’ attribute will contain a string of three digits representing the spin itself. Knowing this, we can build our results() method quite easily. However, I have decided to change the spec a little: now we will call the method display_results() and have it print the results rather than having it return the results to be printed:

    sub display_results {
        my $self = shift;
        print join(" ", split //, $self->{spin}),"\n";
        if ($self->{win}){
            print "Winner paid: $self->{paid} credits!!\n\n";
        } else {
            print "Better luck next time\n\n";
        }

    }

All we do here is grab the object and print out the spin itself by splitting it into separate digits and joining it with a space in between. We then test if the spin was a winning spin and if so we print a congratulatory message stating how much was paid, otherwise we try to encourage the loser to bet some more money.

*****

Last week we started our Slot module and defined a constructor. We tested it my creating a new object and accessing its ‘credits’ key, which we said was a Bad Thing(tm). Let’s add an object routine to our module that returns the current value of the ‘credits’ attribute (this is called an accessor method):

    sub credits {
        my $self = shift;
        return $self->{credits};
    }

It is OK to access the datastructure directly inside the object module, it is the outside world that should get its information from object methods. This method shifts off the first argument, which will be the object itself (a reference to the hash) and returns the value of the ‘credits’ key in that hash. That’s it. We can now modify the little test script from last week to use this method rather than accessing the value directly:

    #!/usr/bin/perl -w
    use strict;
    use Slot;
    my $slot = Slot->new(100);
    print $slot->credits(),"\n";

Why is this better than directly accessing the hash key itself? Because, as a user of this module, we aren’t supposed to know (or care) that the object is a hash. It could have been an array reference, or it could be in the next release. If we wrote code that accessed the object as a hash, and then we downloaded the latest version and the author changed it to use an array reference underneath, all our current code would break. Just to show you, let’s rebuild the module using an array:

    package Slot;
    use strict;

    sub new {
        my $class   = shift;
        my $credits = shift || 100;
        my $self    = [ $credits, # credits
                        1,        # bet
                        0,        # win
                        0,        # paid
                        undef,    # spin
                       ];
        return bless $self, $class;
    }

    sub credits {
        my $self = shift;
        return $self->[0];
    }

    1;
    __END__

Maybe the module author decided that array accesses are faster (not enough to warrant using them in this case for sure, but it’s an example), and changed the module to this version. Our new code that uses the credits() method still works just fine, but our old code that used $slot->{credits} won’t work at all now.

And that’s a very important point about objects — the object encapsulates the data and provides an interface for us to use. Just like we don’t need to know how a real slot machine (or radio) works inside, we shouldn’t need to know how our object is built on the inside (unless we are the ones building it of course). That means, as an object builder, you need to provide any methods the user might need to operate the object. This means you will be free in the future to change the underlying object and the user never needs to know and doesn’t have to worry about a new version breaking old programs that use it.

Let’s quickly add another attribute method, the bet() method:

    sub bet {
        my $self     = shift;
        $self->{bet} = shift || $self->{bet};
    }

This is a dual purpose method — we not only have a way to retrieve the current betting amount, we can also set it at the same time. This is a useful way of creating accessor methods instead of creating separate get_bet() and set_bet() methods. If an argument is passed to this method and it is not 0, we set the bet attribute to the new value and return it, otherwise we use the old value. We haven’t done any error checking to ensure an integer was passed in, that is an exercise for the reader.

We haven’t yet actually defined how our slot machine will work, and that will be the subject of next week’s discussion.

*****

The basic framework of an OO module is simpler than a standard module because OO modules don’t export anything.

    package Slot.pm
    use strict;

    # any class data

    # class and object methods (subroutines) here

    1;
    __END__

Like a normal module you provide a package name and end with a true value. In between you define whatever class data (if any) you need, and write the subroutines that create an instance of the object (the ‘constructor’) or provide methods that the object can perform.

The only real difference between an object or class method and an ordinary subroutine is that perl does a little magic relating to the first argument the subroutine gets. Recall how methods (class or object) are called:

    my $obj = MyClass->new('argument');   # constructor: class method
    $obj->some_method('argument');        # object or instance method

You may also see methods called using the indirect object syntax:

    my $obj = new MyClass 'argument';

Most people avoid this calling form except for a class method such as the constructor. Either way, you need to know that first argument to the routine is the object itself (for an object method), or the class name (for a class method such as the constructor).

Typically the constructor is named new(), but that is only a convention. We wanted our constructor to be called with an optional argument defining how many credits to start with:

    my $slot = Slot->new(100);

So, our constructor will begin like:

    sub new {
        my $class   = shift;         # class name is first argument
        my $credits = shift || 100;
        # ... more stuff
    }

Now we have enough information to start construction of our object, but what is an object? An object is simply a reference to anything that you can take a reference to, and that reference is "blessed" into the class (we will get to that shortly). Quite often a hash reference is used because it provides a convenient way to have named attributes or properties in the object (attributes are the actual data the object stores). Our Slot object will need a few attributes: the number of credits remaining on the machine, the current betting amount, the spin result (what is displayed), and information regarding whether it was a winning spin and how much was paid. Our Slot module and constructor now look like:

    package Slot;
    use strict;

    sub new {
        my $class   = shift;
        my $credits = shift || 100;
        my $self    = { credits => $credits,
                        bet     => 1,
                        win     => 0,
                        paid    => 0,
                        spin    => undef,
                       };
        return bless $self, $class;
    }

    1;
    __END__

That’s it — we now have an OO module that creates an instance of a slot machine. It doesn’t do anything now because we haven’t created methods for it, but you can actually test this module:

    #!/usr/bin/perl -w
    use strict;
    use Slot;
    my $slot = Slot->new(100);
    print $slot->{credits},"\n";

Note, the $slot variable is really just a reference to a hash, and we have used it as an ordinary reference to access the ‘credits’ key. This is a Bad Thing(tm), and I only show it to you to demonstrate that the object is simply the hash reference we got back from the new() method. However, it isn’t really just a hash now, it has been "blessed". The bless() function is a perl built-in that associates a reference with a class — this is what will allow perl to find a given objects methods (remember, we didn’t import anything). Our Slot class doesn’t define any object methods yet, and that is the topic for next week’s discussion.

*****