From: Shawn M Moore <sartak@gmail.com>
Date: Thu, 5 Feb 2009 16:36:28 +0000 (+0000)
Subject: MouseX::Types is now in its own dist
X-Git-Tag: 0.19~50
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4786262b51c7c709fa9fb9d4e64235ad385d96f5;p=gitmo%2FMouse.git

MouseX::Types is now in its own dist
---

diff --git a/Changes b/Changes
index 7de5e21..cba9d0e 100644
--- a/Changes
+++ b/Changes
@@ -28,6 +28,8 @@ Revision history for Mouse
 
     * Implement "override" and "super"
 
+    * MouseX::Types is now in its own dist
+
 0.14 Sat Dec 20 16:53:05 2008
     * POD fix
 
diff --git a/lib/MouseX/Types.pm b/lib/MouseX/Types.pm
deleted file mode 100644
index d6e2d9d..0000000
--- a/lib/MouseX/Types.pm
+++ /dev/null
@@ -1,114 +0,0 @@
-package MouseX::Types;
-use strict;
-use warnings;
-
-require Mouse::Util::TypeConstraints;
-use MouseX::Types::TypeDecorator;
-
-sub import {
-    my $class  = shift;
-    my %args   = @_;
-    my $caller = caller(0);
-
-    no strict 'refs';
-    *{"$caller\::import"} = sub { my $pkg = caller(0); _import($caller, $pkg, @_) };
-    push @{"$caller\::ISA"}, 'MouseX::Types::Base';
-
-    if (defined $args{'-declare'} && ref($args{'-declare'}) eq 'ARRAY') {
-        my $storage = $caller->type_storage($caller);
-        for my $name (@{ $args{'-declare'} }) {
-            my $obj = $storage->{$name} = "$caller\::$name";
-            *{"$caller\::$name"} = sub () { $obj };
-        }
-    }
-
-    return Mouse::Util::TypeConstraints->export_to_level(1, $class);
-}
-
-sub _import {
-    my($type_class, $pkg, @types) = @_;
-    no strict 'refs';
-    for my $name (@types) {
-        my $obj = $type_class->type_storage->{$name};
-        $obj = $type_class->type_storage->{$name} = MouseX::Types::TypeDecorator->new($obj)
-            unless ref($obj);
-        *{"$pkg\::$name"} = sub () { $obj };
-    }
-}
-
-{
-    package MouseX::Types::Base;
-    my %storage;
-    sub type_storage {
-        $storage{$_[0]} ||= +{}
-    }
-}
-
-1;
-
-=head1 NAME
-
-MouseX::Types - Organise your Mouse types in libraries
-
-=head1 SYNOPSIS
-
-=head2 Library Definition
-
-  package MyLibrary;
-
-  # predeclare our own types
-  use MouseX::Types 
-    -declare => [qw(
-        PositiveInt NegativeInt
-    )];
-
-  # import builtin types
-  use MouseX::Types::Mouse 'Int';
-
-  # type definition.
-  subtype PositiveInt, 
-      as Int, 
-      where { $_ > 0 },
-      message { "Int is not larger than 0" };
-  
-  subtype NegativeInt,
-      as Int,
-      where { $_ < 0 },
-      message { "Int is not smaller than 0" };
-
-  # type coercion
-  coerce PositiveInt,
-      from Int,
-          via { 1 };
-
-  1;
-
-=head2 Usage
-
-  package Foo;
-  use Mouse;
-  use MyLibrary qw( PositiveInt NegativeInt );
-
-  # use the exported constants as type names
-  has 'bar',
-      isa    => PositiveInt,
-      is     => 'rw';
-  has 'baz',
-      isa    => NegativeInt,
-      is     => 'rw';
-
-  sub quux {
-      my ($self, $value);
-
-      # test the value
-      print "positive\n" if is_PositiveInt($value);
-      print "negative\n" if is_NegativeInt($value);
-
-      # coerce the value, NegativeInt doesn't have a coercion
-      # helper, since it didn't define any coercions.
-      $value = to_PositiveInt($value) or die "Cannot coerce";
-  }
-
-  1;
-
-=cut
diff --git a/lib/MouseX/Types/Mouse.pm b/lib/MouseX/Types/Mouse.pm
deleted file mode 100644
index 1d62675..0000000
--- a/lib/MouseX/Types/Mouse.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package MouseX::Types::Mouse;
-use strict;
-use warnings;
-
-BEGIN { require Mouse::Util::TypeConstraints }
-use MouseX::Types;
-
-BEGIN {
-    my $builtin_type = +{ map { $_ => $_ } Mouse::Util::TypeConstraints->list_all_builtin_type_constraints };
-    sub type_storage { $builtin_type }
-}
-
-1;
-
-
diff --git a/lib/MouseX/Types/TypeDecorator.pm b/lib/MouseX/Types/TypeDecorator.pm
deleted file mode 100644
index 11ad46d..0000000
--- a/lib/MouseX/Types/TypeDecorator.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-package MouseX::Types::TypeDecorator;
-
-use strict;
-use warnings;
-
-use Scalar::Util 'blessed';
-
-use overload(
-    '""' => sub { ${ $_[0] } },
-    '|' => sub {
-        
-        ## It's kind of ugly that we need to know about Union Types, but this
-        ## is needed for syntax compatibility.  Maybe someday we'll all just do
-        ## Or[Str,Str,Int]
-        
-        my @tc = grep {blessed $_} @_;
-        use Data::Dumper;
-        my $ret;
-        if (ref($_[0])) {
-            $ret = ${ $_[0] };
-        } else {
-            $ret = $_[0];
-        }
-        $ret .= '|';
-        if (ref($_[1])) {
-            $ret .= ${ $_[1] };
-        } else {
-            $ret .= $_[1];
-        }
-        $ret;
-    },
-    fallback => 1,
-    
-);
-
-sub new {
-    my $type = $_[1];
-    bless \$type, $_[0];
-}
-
-1;
diff --git a/t/800_shikabased/003-make_immutable.t b/t/800_shikabased/003-make_immutable.t
deleted file mode 100644
index d1539b4..0000000
--- a/t/800_shikabased/003-make_immutable.t
+++ /dev/null
@@ -1,85 +0,0 @@
-use strict;
-use warnings;
-use Test::More tests => 18;
-use Test::Exception;
-use Scalar::Util qw/isweak/;
-
-{
-    package Headers;
-    use Mouse;
-    has data => (
-        is => 'rw',
-        isa => 'Str',
-    );
-    no Mouse;
-}
-
-{
-    package Types;
-    use MouseX::Types -declare => [qw/Foo/];
-    use MouseX::Types::Mouse 'HashRef';
-    class_type Foo, { class => 'Headers' };
-    coerce Foo,
-        from HashRef,
-        via {
-        Headers->new($_);
-    };
-}
-
-
-&main; exit;
-
-sub construct {
-    my $class = shift;
-    eval <<"...";
-    package $class;
-    use Mouse;
-    BEGIN { Types->import('Foo') }
-    has bone => (
-        is => 'rw',
-        required => 1,
-    );
-    has foo => (
-        is     => 'rw',
-        isa    => Foo,
-        coerce => 1,
-    );
-    has weak_foo => (
-        is       => 'rw',
-        weak_ref => 1,
-    );
-    has trigger_foo => (
-        is => 'rw',
-        trigger => sub { \$_[0]->bone('eat') },
-    );
-    sub BUILD { main::ok "calling BUILD in SoftDog" }
-    no Mouse;
-...
-    die $@ if $@;
-}
-
-sub test {
-    my $class = shift;
-    lives_ok { $class->new(bone => 'moo') } "$class new";
-    throws_ok { $class->new() } qr/\QAttribute (bone) is required/;
-    is($class->new(bone => 'moo', foo => { data => 3 })->foo->data, 3);
-
-    my $foo = Headers->new();
-    ok(Scalar::Util::isweak($class->new(bone => 'moo', weak_foo => $foo)->{weak_foo}));
-
-    {
-        my $o = $class->new(bone => 'moo');
-        $o->trigger_foo($foo);
-        is($o->bone, 'eat');
-    }
-}
-
-sub main {
-    construct('SoftDog');
-    test('SoftDog');
-
-    construct('HardDog');
-    HardDog->meta->make_immutable;
-    test('HardDog');
-}
-
diff --git a/t/800_shikabased/801-mousex_types.t b/t/800_shikabased/801-mousex_types.t
deleted file mode 100644
index 1b82811..0000000
--- a/t/800_shikabased/801-mousex_types.t
+++ /dev/null
@@ -1,118 +0,0 @@
-use strict;
-use warnings;
-use Test::More tests => 16;
-
-{
-    package Types;
-    use MouseX::Types -declare => [qw/ Headers /];
-    use MouseX::Types::Mouse 'HashRef';
-
-    type Headers, where { defined $_ && eval { $_->isa('Headers1') } };
-    coerce Headers,
-        from HashRef, via {
-            Headers1->new(%{ $_ });
-        },
-    ;
-}
-
-{
-    package Types2;
-    use MouseX::Types -declare => [qw/ Headers /];
-    use MouseX::Types::Mouse 'HashRef';
-
-    type Headers, where { defined $_ && eval { $_->isa('Headers2') } };
-    coerce Headers,
-        from HashRef, via {
-            Headers2->new(%{ $_ });
-        },
-    ;
-}
-
-{
-    package Headers1;
-    use Mouse;
-    has 'foo' => ( is => 'rw' );
-}
-
-{
-    package Headers2;
-    use Mouse;
-    has 'foo' => ( is => 'rw' );
-}
-
-{
-    package Response;
-    use Mouse;
-    BEGIN { Types->import(qw/ Headers /) }
-
-    has headers => (
-        is     => 'rw',
-        isa    => Headers,
-        coerce => 1,
-    );
-}
-
-{
-    package Request;
-    use Mouse;
-    BEGIN { Types->import(qw/ Headers /) }
-
-    has headers => (
-        is     => 'rw',
-        isa    => Headers,
-        coerce => 1,
-    );
-}
-
-{
-    package Response2;
-    use Mouse;
-    BEGIN { Types2->import(qw/ Headers /) }
-
-    has headers => (
-        is     => 'rw',
-        isa    => Headers,
-        coerce => 1,
-    );
-}
-
-{
-    package Request2;
-    use Mouse;
-    BEGIN { Types2->import(qw/ Headers /) }
-
-    has headers => (
-        is     => 'rw',
-        isa    => Headers,
-        coerce => 1,
-    );
-}
-
-my $res = Response->new(headers => { foo => 'bar' });
-isa_ok($res->headers, 'Headers1');
-is($res->headers->foo, 'bar');
-$res->headers({foo => 'yay'});
-isa_ok($res->headers, 'Headers1');
-is($res->headers->foo, 'yay');
-
-my $req = Request->new(headers => { foo => 'bar' });
-isa_ok($res->headers, 'Headers1');
-is($req->headers->foo, 'bar');
-$req->headers({foo => 'yay'});
-isa_ok($res->headers, 'Headers1');
-is($req->headers->foo, 'yay');
-
-$res = Response2->new(headers => { foo => 'bar' });
-isa_ok($res->headers, 'Headers2');
-is($res->headers->foo, 'bar');
-$res->headers({foo => 'yay'});
-isa_ok($res->headers, 'Headers2');
-is($res->headers->foo, 'yay');
-
-$req = Request2->new(headers => { foo => 'bar' });
-isa_ok($res->headers, 'Headers2');
-is($req->headers->foo, 'bar');
-$req->headers({foo => 'yay'});
-isa_ok($res->headers, 'Headers2');
-is($req->headers->foo, 'yay');
-
diff --git a/t/800_shikabased/802-mousex_types-isa-or.t b/t/800_shikabased/802-mousex_types-isa-or.t
deleted file mode 100644
index 693b9a1..0000000
--- a/t/800_shikabased/802-mousex_types-isa-or.t
+++ /dev/null
@@ -1,77 +0,0 @@
-use strict;
-use warnings;
-use Test::More tests => 13;
-
-{
-    package Types;
-    use strict;
-    use warnings;
-    use MouseX::Types -declare => [qw/ Baz Type1 Type2 /];
-    use MouseX::Types::Mouse qw( ArrayRef );
-
-    type Baz, where { defined($_) && $_ eq 'Baz' };
-    coerce Baz, from ArrayRef, via { 'Baz' };
-
-    type Type1, where { defined($_) && $_ eq 'Name' };
-    coerce Type1, from 'Str', via { 'Names' };
-
-    type Type2, where { defined($_) && $_ eq 'Group' };
-    coerce Type2, from 'Str', via { 'Name' };
-
-}
-
-{   
-    package Foo;
-    use Mouse;
-    use MouseX::Types::Mouse qw( Str Undef );
-    BEGIN { Types->import(qw( Baz Type1 )) }
-    has 'bar' => ( is => 'rw', isa => Str | Baz | Undef, coerce => 1 );
-}
-
-eval {
-    Foo->new( bar => +{} );
-};
-ok $@, 'not got an object';
-
-eval {
-    isa_ok(Foo->new( bar => undef ), 'Foo');
-};
-ok !$@, 'got an object 1';
-
-eval {
-    isa_ok(Foo->new( bar => 'foo' ), 'Foo');
-
-};
-ok !$@, 'got an object 2';
-
-
-my $f = Foo->new;
-eval {
-    $f->bar([]);
-};
-ok !$@;
-is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)';
-
-eval {
-    $f->bar('hoge');
-};
-ok !$@;
-is $f->bar, 'hoge', 'bar is hoge';
-
-eval {
-    $f->bar(undef);
-};
-ok !$@;
-is $f->bar, undef, 'bar is undef';
-
-
-{   
-    package Bar;
-    use Mouse;
-    BEGIN { Types->import(qw( Type1 Type2 )) }
-    has 'foo' => ( is => 'rw', isa => Type1 | Type2 , coerce => 1 );
-}
-
-my $foo = Bar->new( foo => 'aaa' );
-ok $foo, 'got an object 3';
-is $foo->foo, 'Name', 'foo is Name';