maybe a more concise synopsis
John Napiorkowski [Thu, 24 Jun 2010 18:30:50 +0000 (14:30 -0400)]
lib/MooseX/Types/Parameterizable.pm
t/05-pod-examples.t [new file with mode: 0644]

index 18e3951..861773b 100644 (file)
@@ -15,47 +15,40 @@ MooseX::Types::Parameterizable - Create your own Parameterizable Types.
 
 =head1 SYNOPSIS
 
-Within your L<MooseX::Types> declared library module:
+The follow is example usage.
 
-    use Set::Scalar;
+    use Moose;
     use MooseX::Types::Parameterizable qw(Parameterizable);
-    use MooseX::Types::Moose qw(Int );
-    use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet)];
-    
-    subtype Set,
-        as class_type("Set::Scalar");
-
-    subtype UniqueInt,
-        as Parameterizable[Int, Set],
-        where {
-            my ($int, $set) = @_;
-            return !$set->has($int);
-        };
-        
-    subtype PositiveSet,
-        as Set,
-        where {
-            my ($set) = @_;
-            return !grep {$_ <0 } $set->members;
-        };
-        
-    subtype PositiveUniqueInt,
-        as UniqueInt[PositiveSet];
-    
-    my $set = Set::Scalar->new(1,2,3);
+    use MooseX::Types::Moose qw(Str Int);
+    use MooseX::Types -declare=>[qw(Varchar)];
 
-    UniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
-    UniqueInt([$set])->check(-99);  ## Okay, -99 isn't in (1,2,3)
-    UniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
-    
-    PositiveUniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
-    PositiveUniqueInt([$set])->check(-99);  ## Not OK, -99 not Positive Int
-    PositiveUniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
-    
-    my $negative_set = Set::Scalar->new(-1,-2,-3);
-    
-    UniqueInt([$negative_set])->check(100);  ## Throws exception
-        
+    subtype Varchar,
+      as Parameterizable[Str,Int],
+      where {
+        my($string, $int) = @_;
+        $int >= length($string) ? 1:0;
+      },
+      message {
+        "'$_' is too long"
+      };
+
+    has varchar_five => (isa=>Varchar[5], is=>'ro');
+    has varchar_ten => (isa=>Varchar[10], is=>'ro');
+  
+    ## This works fine
+    my $object1 = __PACKAGE__->new(
+        varchar_five => '1234',
+        varchar_ten => '123456789',
+    );
+
+    ## This explodes with a type constraint error
+    my $object2 = __PACKAGE__->new(
+        varchar_five => '12345678', ## Too long string
+        varchar_ten => '123456789',
+    );
+
+See t/05-pod-examples.t for runnable versions of all POD code
+         
 =head1 DESCRIPTION
 
 A L<MooseX::Types> library for creating parameterizable types.  A parameterizable type
diff --git a/t/05-pod-examples.t b/t/05-pod-examples.t
new file mode 100644 (file)
index 0000000..061dcec
--- /dev/null
@@ -0,0 +1,146 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Set::Scalar"; if($@) {
+    plan skip_all => 'Set::Scalar not installed';
+}
+
+
+{
+    package Test::MooseX::Types::Parameterizable::Synopsis;
+
+    use Moose;
+    use MooseX::Types::Parameterizable qw(Parameterizable);
+    use MooseX::Types::Moose qw(Str Int);
+    use MooseX::Types -declare=>[qw(Varchar)];
+
+    subtype Varchar,
+      as Parameterizable[Str,Int],
+      where {
+        my($string, $int) = @_;
+        $int >= length($string) ? 1:0;
+      },
+      message { "'$_' is too long"  };
+
+    my $varchar_five = Varchar[5];
+
+    Test::More::ok $varchar_five->check('four');
+    Test::More::ok ! $varchar_five->check('verylongstrong');
+
+    my $varchar_ten = Varchar[10];
+
+    Test::More::ok $varchar_ten->check( 'X' x 9 );
+    Test::More::ok ! $varchar_ten->check( 'X' x 12 );
+
+    has varchar_five => (isa=>Varchar[5], is=>'ro');
+    has varchar_ten => (isa=>Varchar[10], is=>'ro');
+  
+    my $object1 = __PACKAGE__->new(
+        varchar_five => '1234',
+        varchar_ten => '123456789',
+    );
+
+    eval {
+        my $object2 = __PACKAGE__->new(
+            varchar_five => '12345678',
+            varchar_ten => '123456789',
+        );
+    };
+
+    Test::More::ok $@, 'There was an error';
+    Test::More::like $@, qr('12345678' is too long), 'Correct custom error';
+}
+
+done_testing;
+
+
+__END__
+
+use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )];
+
+subtype Set,
+  as class_type("Set::Scalar");
+
+subtype UniqueInt,
+  as Parameterizable[Int, Set],
+  where {
+    my ($int, $set) = @_;
+    !$set->has($int);
+  };
+
+subtype PositiveSet,
+  as Set,
+  where {
+    my ($set) = @_;
+    ! grep { $_ < 0 } $set->members;
+  };
+  
+subtype PositiveUniqueInt,
+  as UniqueInt[PositiveSet];
+
+my $set = Set::Scalar->new(-1,-2,1,2,3);
+my $positive_set = Set::Scalar->new(1,2,3);
+my $negative_set = Set::Scalar->new(-1,-2,-3);
+
+ok Set->check($set),
+ 'Is a Set';
+
+ok Set->check($positive_set),
+ 'Is a Set';
+
+ok Set->check($negative_set),
+ 'Is a Set';
+
+ok !PositiveSet->check($set),
+ 'Is Not a Positive Set';
+
+ok PositiveSet->check($positive_set),
+ 'Is a Positive Set';
+
+ok !PositiveSet->check($negative_set),
+ 'Is Not a Positive Set';
+
+ok UniqueInt([$set])->check(100),
+ '100 not in Set';
+
+ok UniqueInt([$positive_set])->check(100),
+ '100 not in Set';
+
+ok UniqueInt([$negative_set])->check(100),
+ '100 not in Set';
+
+ok UniqueInt([$set])->check(-99),
+ '-99 not in Set';
+
+ok UniqueInt([$positive_set])->check(-99),
+ '-99 not in Set';
+
+ok UniqueInt([$negative_set])->check(-99),
+  '-99 not in Set';
+
+ok !UniqueInt([$set])->check(2),
+ '2 in Set';
+
+ok !UniqueInt([$positive_set])->check(2),
+ '2 in Set';
+
+ok UniqueInt([$negative_set])->check(2),
+  '2 not in Set';
+
+
+__END__
+
+ok UniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
+ok UniqueInt([$set])->check(-99);  ## Okay, -99 isn't in (1,2,3)
+ok !UniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
+
+ok PositiveUniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
+ok !PositiveUniqueInt([$set])->check(-99);  ## Not OK, -99 not Positive Int
+ok !PositiveUniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
+
+my $negative_set = Set::Scalar->new(-1,-2,-3);
+
+ok UniqueInt([$negative_set])->check(100);  ## Throws exception
+