t/006_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 1;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 =pod
  14
  15     package Constraint;
  16     use strict;
  17     use warnings;
  18     use Moose;
  19
  20     sub validate      { confess "Abstract method!" }
  21     sub error_message { confess "Abstract method!" }
  22
  23     sub validation_value {
  24         my ($self, $field) = @_;
  25         return $field->value;
  26     }
  27
  28     package Constraint::AtLeast;
  29     use strict;
  30     use warnings;
  31     use Moose;
  32
  33     extends 'Constraint';
  34
  35     has 'value' => (isa => 'Num', is => 'ro');
  36
  37     sub validate {
  38         my ($self, $field) = @_;
  39         if ($self->validation_value($field) >= $self->value) {
  40             return undef;
  41         }
  42         else {
  43             return $self->error_message;
  44         }
  45     }
  46
  47     sub error_message { 'must be at least ' . (shift)->value; }
  48
  49     package Constraint::NoMoreThan;
  50     use strict;
  51     use warnings;
  52     use Moose;
  53
  54     extends 'Constraint';
  55
  56     has 'value' => (isa => 'Num', is => 'ro');
  57
  58     sub validate {
  59         my ($self, $field) = @_;
  60         if ($self->validation_value($field) <= $self->value) {
  61             return undef;
  62         } else {
  63             return $self->error_message;
  64         }
  65     }
  66
  67     sub error_message { 'must be no more than ' . (shift)->value; }
  68
  69     package Constraint::OnLength;
  70     use strict;
  71     use warnings;
  72     use Moose::Role;
  73
  74     has 'units' => (isa => 'Str', is => 'ro');
  75
  76     override 'value' => sub {
  77         return length(super());
  78     };
  79
  80     override 'error_message' => sub {
  81         my $self = shift;
  82         return super() . ' ' . $self->units;
  83     };
  84
  85     package Constraint::LengthNoMoreThan;
  86     use strict;
  87     use warnings;
  88     use Moose;
  89
  90     extends 'Constraint::NoMoreThan';
  91        with 'Constraint::OnLength';
  92
  93    package Constraint::LengthAtLeast;
  94    use strict;
  95    use warnings;
  96    use Moose;
  97
  98    extends 'Constraint::AtLeast';
  99       with 'Constraint::OnLength';
 100
 101 =cut