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