I reckon that what you're looking at here is the 'State' pattern rather than a 'Strategy'.

package Ticket;

use strict;
use warnings;

...

sub state {
    my $self = shift;
    $self->{state} ||= TicketState::New->new();
}

sub set_state {
    my $self = shift;
    my $new_state = shift;
    push @{$self->{statelog}}, $self->{state};
    $self->{state} = $new_state;
    return $self;
}

sub send_to_supervisor {
    my $self = shift;
    $self->state->send_ticket_to_supervisor(@_);
}

sub approve {
    my $self = shift;
    $self->state->approve_ticket($self, @_);
}

sub reject { 
    my $self = shift;
    $self->state->reject_ticket($self, @_);
}

package TicketState::New;

...


sub send_ticket_to_supervisor {
    my $self = shift;
    my $ticket = shift;
    
    my $supervisor = $SUPERVISORS{$ticket->topic}; # Deliberately naiv
+e
    $ticket->set_state(TicketState::PendingApproval->new);
    $supervisor->accept($ticket);
    return $ticket;
}

sub approve_ticket { die "You cannot approve a ticket in this state" }

sub reject_ticket { die "You cannot reject a ticket in this state" }

package TicketState::PendingApproval;

sub send_ticket_to_supervisor {
   die "Ticket was already sent to a supervisor!";
}

sub approve_ticket {
    my $self = shift;
    my($ticket, $supervisor) = @_;

    $ticket->set_state(TicketState::Approved->new
                          ->set_owner($supervisor));
    $supervisor->editorial_group->accept($ticket);
    return $ticket;
}

sub reject_ticket {
    my $self = shift;
    my($ticket, $supervisor) = @_;
    
    $ticket->set_state(TicketState::Rejected->new
                          ->set_owner($supervisor));
    $ticket->author->accept($ticket);
    return $ticket;
}

package TicketState::Rejected;

# Almost indistinguishable from TicketState::New
use base 'TicketState::New';
[download]

And so on.... Appropriate use of inheritance would mean that individual states would only have to know about the valid actions in that state, and their associated state transition rules, and it's easy to plug new states into the system. I've also found that when I use the State pattern it's easier to use meaningful names for actions without having to worry about whether an action is 'allowed' because the State system handles that for me -- I just move any state dependent behaviour into the appropriate state classes (or the approprate parent state object) and delegate happily.

One problem with the State pattern is that, until you're used to it, it can be hard to get a handle on the behaviour of the 'whole' system but I'd be tempted to argue that you should be reading your tests and use cases for that.

---

---

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:

  <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>

• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or How to display code and escape characters are good places to start.