lib/Moose/Cookbook/Recipe6.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Recipe6 - The Moose::Role example
   7
   8 =head1 SYNOPSIS
   9
  10   package Constraint;
  11   use strict;
  12   use warnings;
  13   use Moose::Role;
  14
  15   has 'value' => (isa => 'Int', is => 'ro');
  16
  17   around 'validate' => sub {
  18       my $c = shift;
  19       my ($self, $field) = @_;
  20       return undef if $c->($self, $self->validation_value($field));
  21       return $self->error_message;
  22   };
  23
  24   sub validation_value {
  25       my ($self, $field) = @_;
  26       return $field;
  27   }
  28
  29   sub error_message { confess "Abstract method!" }
  30
  31   package Constraint::OnLength;
  32   use strict;
  33   use warnings;
  34   use Moose::Role;
  35
  36   has 'units' => (isa => 'Str', is => 'ro');
  37
  38   override 'validation_value' => sub {
  39       return length(super());
  40   };
  41
  42   override 'error_message' => sub {
  43       my $self = shift;
  44       return super() . ' ' . $self->units;
  45   };
  46
  47   package Constraint::AtLeast;
  48   use strict;
  49   use warnings;
  50   use Moose;
  51
  52   with 'Constraint';
  53
  54   sub validate {
  55       my ($self, $field) = @_;
  56       ($field >= $self->value);
  57   }
  58
  59   sub error_message { 'must be at least ' . (shift)->value; }
  60
  61   package Constraint::NoMoreThan;
  62   use strict;
  63   use warnings;
  64   use Moose;
  65
  66   with 'Constraint';
  67
  68   sub validate {
  69       my ($self, $field) = @_;
  70       ($field <= $self->value);
  71   }
  72
  73   sub error_message { 'must be no more than ' . (shift)->value; }
  74
  75   package Constraint::LengthNoMoreThan;
  76   use strict;
  77   use warnings;
  78   use Moose;
  79
  80   extends 'Constraint::NoMoreThan';
  81      with 'Constraint::OnLength';
  82
  83   package Constraint::LengthAtLeast;
  84   use strict;
  85   use warnings;
  86   use Moose;
  87
  88   extends 'Constraint::AtLeast';
  89      with 'Constraint::OnLength';
  90
  91 =head1 DESCRIPTION
  92
  93 Coming Soon.
  94
  95 =head1 AUTHOR
  96
  97 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  98
  99 =head1 COPYRIGHT AND LICENSE
 100
 101 Copyright 2006 by Infinity Interactive, Inc.
 102
 103 L<http://www.iinteractive.com>
 104
 105 This library is free software; you can redistribute it and/or modify
 106 it under the same terms as Perl itself.
 107
 108 =cut
 109