Data::Conveyor::Value::Ticket::Stage - Stage-based conveyor-belt-like ticket handling system

use 5.008;
use strict;
use warnings;

package Data::Conveyor::Value::Ticket::Stage;
BEGIN {
  $Data::Conveyor::Value::Ticket::Stage::VERSION = '1.103130';
}
# ABSTRACT: Stage-based conveyor-belt-like ticket handling system


# we need a delegate and therefore need the proper subclasses
use parent qw(
  Class::Value
  Class::Scaffold::Storable
);
__PACKAGE__->mk_scalar_accessors(qw(name position));

# Alternative constructor: only takes a name, sets start position
sub pos_name_start {
    my $self = shift;
    $self->delegate->STAGE_START;
}

sub pos_name_active {
    my $self = shift;
    $self->delegate->STAGE_ACTIVE;
}

sub pos_name_end {
    my $self = shift;
    $self->delegate->STAGE_END;
}

sub new_from_name {
    my ($self, $name, %args) = @_;
    $self->new(
        value => sprintf('%s_%s', $self->pos_name_start, $name),
        %args
    );
}

sub new_start {
    my $self = shift;
    $self->new_from_name(@_)->set_start;
}

sub new_active {
    my $self = shift;
    $self->new_from_name(@_)->set_active;
}

sub new_end {
    my $self = shift;
    $self->new_from_name(@_)->set_end;
}

sub get_value {
    my $self = shift;
    return unless $self->position && $self->name;
    sprintf '%s_%s', $self->position, $self->name;
}

sub set_value {
    my ($self,     $value) = @_;
    my ($position, $name)  = $self->split_value($value);
    $self->position($position);
    $self->name($name);
    $self;
}

# expects a string like 'ende_policy'
sub is_well_formed_value {
    my ($self, $value) = @_;
    $self->SUPER::is_well_formed_value($value)
      && defined $self->split_value($value);
}

sub split_value {
    my ($self, $value) = @_;
    our $pos_re ||= join '|' =>
      ($self->pos_name_start, $self->pos_name_active, $self->pos_name_end);
    return unless defined($value) && length($value);
    return unless $value =~ /^($pos_re)_([\w_]+)$/;
    return ($1, $2);
}

# these methods return $self to allow chaining
sub set_start  { $_[0]->position($_[0]->pos_name_start);  $_[0] }
sub set_active { $_[0]->position($_[0]->pos_name_active); $_[0] }
sub set_end    { $_[0]->position($_[0]->pos_name_end);    $_[0] }
sub is_start  { $_[0]->position eq $_[0]->pos_name_start }
sub is_active { $_[0]->position eq $_[0]->pos_name_active }
sub is_end    { $_[0]->position eq $_[0]->pos_name_end }
1;


__END__