Class-Enumeration

 view release on metacpan or  search on metacpan

lib/Class/Enumeration.pod  view on Meta::CPAN

  use warnings;

  package TurnstileState;

  use parent 'Class::Enumeration';

  # Define list of enum objects
  my @values;
  sub values { no critic ( ProhibitBuiltinHomonyms )
    my $ordinal = 0;
    @values = map { __PACKAGE__->_new( $ordinal++, $_ ) } qw( Locked Unlocked )
      unless @values;
    @values
  }

  1

=head1 CAVEAT

This class is abstract. It defines and partially implements the API
of enum classes. It should not be used directly. You should use the

t/TurnstileState.t  view on Meta::CPAN

  plan tests => 10;

  for my $self ( $class->values ) {
    note my $name = $self->name;
    cmp_ok "$self", 'eq', $name, 'Check default stringification';
    isa_ok $self, $class;
    isa_ok $self, 'Class::Enumeration';
    cmp_ok $self, '==', $class->value_of( $self->name ), 'Get enum object reference by name'
  }

  is_deeply [ $class->names ], [ qw( Locked Unlocked ) ], 'Get names of enum objects';

  dies_ok { $class->value_of( 'Initial' ) } 'No such enum object for the given name'
};

subtest 'Access enum attributes' => sub {
  plan tests => 4;

  my $self = $class->value_of( 'Locked' );
  cmp_ok $self->name,    'eq', 'Locked', 'Get name';
  cmp_ok $self->ordinal, '==', 0,        'Get ordinal';

  $self = $class->value_of( 'Unlocked' );
  cmp_ok $self->name,    'eq', 'Unlocked', 'Get name';
  cmp_ok $self->ordinal, '==', 1,          'Get ordinal'
}

t/TurnstileStateMachine.t  view on Meta::CPAN

  plan tests => 10;

  for my $self ( $class->values ) {
    note my $name = $self->name;
    cmp_ok "$self", 'eq', $name, 'Check default stringification';
    isa_ok $self, $class;
    isa_ok $self, 'Class::Enumeration';
    cmp_ok $self, '==', $class->value_of( $self->name ), 'Get enum object reference by name'
  }

  is_deeply [ $class->names ], [ qw( Locked Unlocked ) ], 'Get names of enum objects';

  dies_ok { $class->value_of( 'Initial' ) } 'No such enum object for the given name'
};

subtest 'Access enum attributes' => sub {
  plan tests => 4;

  my $self = $class->value_of( 'Locked' );
  cmp_ok $self->name,    'eq', 'Locked', 'Get name';
  cmp_ok $self->ordinal, '==', 0,        'Get ordinal';

  $self = $class->value_of( 'Unlocked' );
  cmp_ok $self->name,    'eq', 'Unlocked', 'Get name';
  cmp_ok $self->ordinal, '==', 1,          'Get ordinal'
};

subtest 'Trigger state transitions' => sub {
  plan tests => 7;

  # Set initial state
  isa_ok my $state = Locked, $class;
  dies_ok { $state->do_something( 'foo' ) } 'Wrong input';
  cmp_ok $state->do_something( 'push' ), '==', Locked,   'Still locked';
  cmp_ok $state->do_something( 'coin' ), '==', Unlocked, 'Now unlocked';
  dies_ok { $state->do_something( 'foo' ) } 'Wrong input';
  cmp_ok $state->do_something( 'coin' ), '==', Unlocked, 'Still unlocked';
  cmp_ok $state->do_something( 'push' ), '==', Locked,   'Locked again'
}

t/lib/TurnstileState.pm  view on Meta::CPAN

package TurnstileState;

# On purpose do not use Class::Enumeration::Builder
use parent 'Class::Enumeration';

my @values;

sub values { ## no critic ( ProhibitBuiltinHomonyms )
  unless ( @values ) {
    my $ordinal = 0;
    @values = map { __PACKAGE__->_new( $ordinal++, $_ ) } qw( Locked Unlocked )
  }
  @values
}

1

t/lib/TurnstileStateMachine.pm  view on Meta::CPAN

## no critic ( ProhibitMultiplePackages )

use strict;
use warnings;

# https://en.wikipedia.org/wiki/Finite-state_machine

package TurnstileStateMachine;

use Exporter qw( import );
use Class::Enumeration::Builder { export => 1 }, qw( Locked Unlocked );

package TurnstileStateMachine::Locked;

use Carp qw( croak );

sub do_something {
  my ( $self, $input ) = @_;

  return __PACKAGE__->value_of( 'Unlocked' ) if $input eq 'coin';
  return $self                               if $input eq 'push';
  croak "Wrong input '$input', stooped";
}

package TurnstileStateMachine::Unlocked;

use Carp qw( croak );

sub do_something {
  my ( $self, $input ) = @_;

  return __PACKAGE__->value_of( 'Locked' ) if $input eq 'push';
  return $self                             if $input eq 'coin';
  croak "Wrong input '$input', stooped";
}