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.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.