From: Rafael Kitover <rkitover@cpan.org>
Date: Fri, 29 May 2009 02:51:54 +0000 (-0700)
Subject: add missing files
X-Git-Tag: 0.11^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ca9d7442ae7d1b9268a668d7103e0c9d7aef1dde;hp=b0db42a9693b8247a0b4a90d240d627ec2557555;p=gitmo%2FMooseX-Types.git

add missing files
---

diff --git a/lib/MooseX/Types/CheckedUtilExports.pm b/lib/MooseX/Types/CheckedUtilExports.pm
new file mode 100644
index 0000000..caa27ff
--- /dev/null
+++ b/lib/MooseX/Types/CheckedUtilExports.pm
@@ -0,0 +1,97 @@
+=head1 NAME
+
+MooseX::Types::CheckedUtilExports - Wrap L<Moose::Util::TypeConstraints> to be
+safer for L<MooseX::Types>
+
+=cut
+
+package MooseX::Types::CheckedUtilExports;
+
+use strict;
+use warnings;
+use Moose::Util::TypeConstraints ();
+use Moose::Exporter;
+use Sub::Name;
+use Carp;
+
+use namespace::clean -except => 'meta';
+
+my $StringFoundMsg =
+q{WARNING: String found where Type expected (did you use a => instead of a , ?)};
+
+my @exports = qw/type subtype maybe_type duck_type enum coerce from as/;
+
+=head1 DESCRIPTION
+
+Prevents errors like:
+
+    subtype Foo =>
+    ...
+
+Which should be written as:
+
+    subtype Foo,
+    ...
+
+When using L<MooseX::Types>. Exported by that module.
+
+Exports checked versions of the following subs:
+
+C<type> C<subtype> C<maybe_type> C<duck_type> C<enum> C<coerce> C<from> C<as>
+
+While C<class_type> and C<role_type> will also register the type in the library.
+
+From L<Moose::Util::TypeConstraints>. See that module for syntax.
+
+=cut
+
+Moose::Exporter->setup_import_methods(
+    with_caller => [ @exports, 'class_type', 'role_type' ]
+);
+
+for my $export (@exports) {
+    no strict 'refs';
+
+    *{$export} = sub {
+        my $caller = shift;
+
+        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+
+        carp $StringFoundMsg
+            unless ref($_[0]) ||
+                $_[0] =~ /\b::\b/ || # qualified type
+                $caller->get_registered_class_type($_[0]) ||
+                $caller->get_registered_role_type($_[0]);
+
+        goto &{"Moose::Util::TypeConstraints::$export"};
+    }
+}
+
+sub class_type {
+    my $caller = shift;
+
+    $caller->register_class_type(
+        Moose::Util::TypeConstraints::class_type(@_)
+    );
+}
+
+sub role_type ($;$) {
+    my ($caller, $name, $opts) = @_;
+
+    $caller->register_role_type(
+        Moose::Util::TypeConstraints::role_type($name, $opts)
+    );
+}
+
+=head1 SEE ALSO
+
+L<MooseX::Types>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
diff --git a/lib/MooseX/Types/Combine.pm b/lib/MooseX/Types/Combine.pm
new file mode 100644
index 0000000..a0fbe34
--- /dev/null
+++ b/lib/MooseX/Types/Combine.pm
@@ -0,0 +1,83 @@
+=head1 NAME
+
+MooseX::Types::Combine - Combine type libraries for exporting
+
+=cut
+
+package MooseX::Types::Combine;
+
+use strict;
+use warnings;
+use Class::MOP ();
+
+=head1 SYNOPSIS
+
+    package CombinedTypeLib;
+
+    use base 'MooseX::Types::Combined';
+
+    __PACKAGE__->provide_types_from(qw/TypeLib1 TypeLib2/);
+
+    package UserClass;
+
+    use CombinedTypeLib qw/Type1 Type2 ... /;
+
+=head1 DESCRIPTION
+
+Allows you to export types from multiple type libraries. 
+
+Libraries on the right side of the type libs passed to L</provide_types_from>
+take precedence over those on the left in case of conflicts.
+
+=cut
+
+sub import {
+    my ($class, @types) = @_;
+    my $caller = caller;
+
+    my @type_libs = $class->provide_types_from;
+    Class::MOP::load_class($_) for @type_libs;
+
+    my %types = map {
+        my $lib = $_;
+        map +($_ => $lib), $lib->type_names
+    } @type_libs;
+
+    my %from;
+    push @{ $from{ $types{ $_ } } }, $_ for @types;
+
+    $_->import({ -into => $caller }, @{ $from{ $_ } })
+        for keys %from;
+}
+
+=head1 CLASS METHODS
+
+=head2 provide_types_from
+
+Sets or returns a list of type libraries to re-export from.
+
+=cut
+
+sub provide_types_from {
+    my ($class, @libs) = @_;
+
+    my $store =
+     do { no strict 'refs'; \@{ "${class}::__MOOSEX_TYPELIBRARY_LIBRARIES" } };
+
+    @$store = @libs if @libs;
+
+    @$store;
+}
+
+=head1 SEE ALSO
+
+L<MooseX::Types>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
diff --git a/t/17_syntax_errors.t b/t/17_syntax_errors.t
new file mode 100644
index 0000000..67d7432
--- /dev/null
+++ b/t/17_syntax_errors.t
@@ -0,0 +1,93 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+# remove this when CheckedUtilExports croaks instead of carps
+$SIG{__WARN__} = sub { die @_ };
+
+my $missing_comma_test = q{
+    package TypeLib1;
+
+    use MooseX::Types -declare => ['Foo'];
+    use MooseX::Types::Moose 'Str';
+
+    subtype Foo #,
+        as Str,
+        where { /foo/ },
+        message { 'not a Foo' };
+
+    1;
+};
+
+eval $missing_comma_test;
+like $@, qr/forget a comma/, 'missing comma error';
+
+my $string_as_type_test = q{
+    package TypeLib2;
+
+    use MooseX::Types -declare => ['Foo'];
+    use MooseX::Types::Moose 'Str';
+
+    subtype Foo => # should be ,
+        as Str,
+        where { /foo/ },
+        message { 'not a Foo' };
+
+    1;
+};
+
+eval $string_as_type_test;
+like $@, qr/String found where Type expected/, 'string instead of Type error';
+
+my $fully_qualified_type = q{
+    package TypeLib3;
+
+    use MooseX::Types -declare => ['Foo'];
+    use MooseX::Types::Moose 'Str';
+
+    subtype TypeLib3::Foo =>
+        as Str,
+        where { /foo/ },
+        message { 'not a Foo' };
+
+    1;
+};
+
+eval $fully_qualified_type;
+is $@, '', "fully qualified type doesn't throw error";
+
+my $class_type = q{
+    package TypeLib4;
+
+    use MooseX::Types -declare => ['Foo'];
+    use MooseX::Types::Moose 'Str';
+
+    class_type 'mtfnpy';
+
+    coerce mtfnpy =>
+        from Str,
+        via { bless \$_, 'mtfnpy' };
+
+    1;
+};
+eval $class_type;
+is $@, '', "declared class_types don't throw error";
+
+my $role_type = q{
+    package TypeLib5;
+
+    use MooseX::Types -declare => ['Foo'];
+    use MooseX::Types::Moose 'Str';
+
+    role_type 'mtfnpy';
+
+    coerce mtfnpy =>
+        from Str,
+        via { bless \$_, 'mtfnpy' };
+
+    1;
+};
+eval $role_type;
+is $@, '', "declared role_types don't throw error";
diff --git a/t/18_combined_libs.t b/t/18_combined_libs.t
new file mode 100644
index 0000000..b8dc630
--- /dev/null
+++ b/t/18_combined_libs.t
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/lib";   
+ 
+use Test::More tests => 4;
+
+BEGIN { use_ok 'Combined', qw/Foo2Alias MTFNPY NonEmptyStr/ }
+
+# test that a type from TestLibrary was exported
+ok Foo2Alias;
+
+# test that a type from TestLibrary2 was exported
+ok MTFNPY;
+
+is NonEmptyStr->name, 'TestLibrary2::NonEmptyStr',
+    'precedence for conflicting types is correct';
diff --git a/t/lib/Combined.pm b/t/lib/Combined.pm
new file mode 100644
index 0000000..f0ca9c8
--- /dev/null
+++ b/t/lib/Combined.pm
@@ -0,0 +1,10 @@
+package Combined;
+
+use strict;
+use warnings;
+
+use base 'MooseX::Types::Combine';
+
+__PACKAGE__->provide_types_from(qw/TestLibrary TestLibrary2/);
+
+1;
diff --git a/t/lib/TestLibrary2.pm b/t/lib/TestLibrary2.pm
new file mode 100644
index 0000000..105f0e3
--- /dev/null
+++ b/t/lib/TestLibrary2.pm
@@ -0,0 +1,17 @@
+package TestLibrary2;
+
+use MooseX::Types
+    -declare => [qw( MTFNPY NonEmptyStr )];
+use MooseX::Types::Moose 'Str';
+
+subtype MTFNPY,
+    as Str,
+    where { length $_ },
+    message { 'MTFNPY must not be empty' };
+
+subtype NonEmptyStr,
+    as Str,
+    where { length $_ },
+    message { 'Str must not be empty' };
+
+1;