--- /dev/null
+#
+# This file is a modified version of the MANIFEST.SKIP file
+# from DBIx-Class.
+#
+
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# for developers only :)
+^TODO$
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\.swp$
+\.swo$
+\#$
+\b\.#
+
+# avoid OS X finder files
+\.DS_Store$
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# Skip maint stuff
+^maint/
--- /dev/null
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use inc::Module::Install;
+
+name q{MooseX-TypeLibrary};
+license q{perl};
+author q{Robert 'phaylon' Sedlacek <rs@474.at>};
+all_from q{lib/MooseX/TypeLibrary.pm};
+
+build_requires q{Test::More}, '0.62';
+build_requires q{FindBin}, 0;
+
+requires q{Moose}, '0.19';
+requires q{Sub::Uplevel}, '0.14';
+requires q{Sub::Install}, '0.922';
+requires q{namespace::clean}, 0;
+requires q{Carp}, 0;
+
+WriteAll;
--- /dev/null
+package MooseX::TypeLibrary;
+
+=head1 NAME
+
+MooseX::TypeLibrary - Organise your Moose types in libraries
+
+=cut
+
+use warnings;
+use strict;
+
+use Sub::Uplevel;
+use Moose::Util::TypeConstraints;
+use MooseX::TypeLibrary::Base;
+use Sub::Install qw( install_sub );
+use namespace::clean;
+
+our $VERSION = 0.01;
+
+my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
+
+=head1 SYNOPSIS
+
+ #
+ # Library Definition
+ #
+ package MyLibrary;
+ use strict;
+
+ # predeclare our own types
+ use MooseX::TypeLibrary
+ -declare => [qw( PositiveInt NegativeInt )];
+
+ # import builtin types
+ use MooseX::TypeLibrary::Moose '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;
+
+ #
+ # Usage
+ #
+ package Foo;
+ use Moose;
+ 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;
+
+=head1 DESCRIPTION
+
+The types provided with L<Moose> are by design global. This package helps
+you to organise and selectively import your own and the built-in types in
+libraries. As a nice side effect, it catches typos at compile-time too.
+
+However, the main reason for this module is to provide an easy way to not
+have conflicts with your type names, since the internal fully qualified
+names of the types will be prefixed with the library's name.
+
+This module will also provide you with some helper functions to make it
+easier to use Moose types in your code.
+
+=head1 TYPE HANDLER FUNCTIONS
+
+=head2 $type
+
+A constant with the name of your type. It contains the type's fully
+qualified name. Takes no value, as all constants.
+
+=head2 is_$type
+
+This handler takes a value and tests if it is a valid value for this
+C<$type>. It will return true or false.
+
+=head2 to_$type
+
+A handler that will take a value and coerce it into the C<$type>. It will
+return a false value if the type could not be coerced.
+
+B<Important Note>: This handler will only be exported for types that can
+do type coercion. This has the advantage that a coercion to a type that
+cannot hasn't defined any coercions will lead to a compile-time error.
+
+=head1 LIBRARY DEFINITION
+
+A MooseX::TypeLibrary is just a normal Perl module. Unlike Moose
+itself, it does not install C<use strict> and C<use warnings> in your
+class by default, so this is up to you.
+
+The only thing a library is required to do is
+
+ use MooseX::TypeLibrary -declare => \@types;
+
+with C<@types> being a list of types you wish to define in this library.
+This line will install a proper base class in your package as well as the
+full set of L<handlers|/"TYPE HANDLER FUNCTIONS"> for your declared
+types. It will then hand control over to L<Moose::Util::TypeConstraints>'
+C<import> method to export the functions you will need to declare your
+types.
+
+If you want to use Moose' built-in types (e.g. for subtyping) you will
+want to
+
+ use MooseX::TypeLibrary::Moose @types;
+
+to import the helpers from the shipped L<MooseX::TypeLibrary::Moose>
+library which can export all types that come with Moose.
+
+You will have to define coercions for your types or your library won't
+export a L</to_$type> coercion helper for it.
+
+=head1 LIBRARY USAGE
+
+You can import the L<"type helpers"|/"TYPE HANDLER FUNCTIONS"> of a
+library by C<use>ing it with a list of types to import as arguments. If
+you want all of them, use the C<:all> tag. For example:
+
+ use MyLibrary ':all';
+ use MyOtherLibrary qw( TypeA TypeB );
+
+MooseX::TypeLibrary comes with a library of Moose' built-in types called
+L<MooseX::TypeLibrary::Moose>.
+
+=head1 METHODS
+
+=head2 import
+
+=cut
+
+sub import {
+ my ($class, %args) = @_;
+ my $callee = caller;
+
+ # inject base class into new library
+ { no strict 'refs';
+ unshift @{ $callee . '::ISA' }, 'MooseX::TypeLibrary::Base';
+ }
+
+ # generate predeclared type helpers
+ if (my @declare = @{ $args{ -declare } || [] }) {
+ for my $type (@declare) {
+ $callee->add_type($type);
+ $callee->export_type_into(
+ $callee, $type,
+ sprintf($UndefMsg, $type, $callee),
+ -full => 1,
+ );
+ }
+ }
+
+ # run type constraints import
+ return uplevel 1,
+ Moose::Util::TypeConstraints->can('import'),
+ 'Moose::Util::TypeConstraints';
+}
+
+=head2 type_export_generator
+
+=cut
+
+sub type_export_generator {
+ my ($class, $type, $full) = @_;
+ return sub { $full };
+}
+
+=head2 coercion_export_generator
+
+=cut
+
+sub coercion_export_generator {
+ my ($class, $type, $full, $undef_msg) = @_;
+ return sub {
+ my ($value) = @_;
+
+ # we need a type object
+ my $tobj = find_type_constraint($full) or croak $undef_msg;
+ my $return = $tobj->coerce($value);
+
+ # non-successful coercion returns false
+ return unless $tobj->check($return);
+
+ return $return;
+ }
+}
+
+=head2 check_export_generator
+
+=cut
+
+sub check_export_generator {
+ my ($class, $type, $full, $undef_msg) = @_;
+ return sub {
+ my ($value) = @_;
+
+ # we need a type object
+ my $tobj = find_type_constraint($full) or croak $undef_msg;
+
+ return $tobj->check($value);
+ }
+}
+
+=head1 SEE ALSO
+
+L<Moose>, L<Moose::Util::TypeConstraints>, L<MooseX::TypeLibrary::Moose>
+
+=head1 AUTHOR AND COPYRIGHT
+
+Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
+the C<#moose> cabal on C<irc.perl.org>.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
+1;
--- /dev/null
+package MooseX::TypeLibrary::Base;
+use warnings;
+use strict;
+
+#use Smart::Comments;
+use Sub::Install qw( install_sub );
+use Carp qw( croak );
+use Moose::Util::TypeConstraints;
+use namespace::clean;
+
+my $UndefMsg = q{Unable to find type '%s' in library '%s'};
+
+sub import {
+ my ($class, @types) = @_;
+
+ # flatten out tags
+ @types = map { $_ eq ':all' ? $class->type_names : $_ } @types;
+
+ TYPE:
+ # export all requested types
+ for my $type (@types) {
+ $class->export_type_into(
+ scalar(caller), $type, sprintf $UndefMsg, $type, $class );
+ }
+ return 1;
+}
+
+sub export_type_into {
+ my ($class, $target, $type, $undef_msg, %args) = @_;
+
+ # the real type name and its type object
+ my $full = $class->get_type($type);
+ my $tobj = find_type_constraint($full);
+ ### Exporting: $full
+
+ # install Type name constant
+ install_sub({
+ code => MooseX::TypeLibrary->type_export_generator($type, $full),
+ into => $target,
+ as => $type,
+ });
+
+ # install is_Type test function
+ install_sub({
+ code => MooseX::TypeLibrary
+ ->check_export_generator($type, $full, $undef_msg),
+ into => $target,
+ as => "is_$type",
+ });
+
+ # only install to_Type coercion handler if type can coerce
+ return 1 unless $args{ -full } or $tobj->has_coercion;
+
+ # install to_Type coercion handler
+ install_sub({
+ code => MooseX::TypeLibrary
+ ->coercion_export_generator($type, $full, $undef_msg),
+ into => $target,
+ as => "to_$type",
+ });
+
+ return 1;
+}
+
+sub get_type {
+ my ($class, $type) = @_;
+
+ # useful message if the type couldn't be found
+ croak "Unknown type '$type' in library '$class'"
+ unless $class->has_type($type);
+
+ # return real name of the type
+ return $class->type_storage->{ $type };
+}
+
+sub type_names {
+ my ($class) = @_;
+
+ # return short names of all stored types
+ return keys %{ $class->type_storage };
+}
+
+sub add_type {
+ my ($class, $type) = @_;
+
+ # store type with library prefix as real name
+ $class->type_storage->{ $type } = "${class}::${type}";
+}
+
+sub has_type {
+ my ($class, $type) = @_;
+
+ # check if we stored a type under that name
+ return ! ! $class->type_storage->{ $type };
+}
+
+sub type_storage {
+ my ($class) = @_;
+
+ # return a reference to the storage in ourself
+ { no strict 'refs';
+ return \%{ $class . '::__MOOSEX_TYPELIBRARY_STORAGE' };
+ }
+}
+
+1;
--- /dev/null
+package MooseX::TypeLibrary::Moose;
+use warnings;
+use strict;
+
+use MooseX::TypeLibrary;
+use Moose::Util::TypeConstraints ();
+use namespace::clean;
+
+# all available builtin types as short and long name
+my %BuiltIn_Storage
+ = map { ($_) x 2 }
+ Moose::Util::TypeConstraints->list_all_type_constraints;
+
+# use prepopulated builtin hash as type storage
+sub type_storage { \%BuiltIn_Storage }
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use MooseX::TypeLibrary::Moose ':all';
+
+my @types = MooseX::TypeLibrary::Moose->type_names;
+
+plan tests => @types * 3;
+
+for my $t (@types) {
+ ok my $code = __PACKAGE__->can($t), "$t() was exported";
+ is $code->(), $t, "$t() returns '$t'";
+ ok __PACKAGE__->can("is_$t"), "is_$t() was exported";
+}
+
--- /dev/null
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use TestLibrary ':all';
+
+my @tests = (
+ [ 'NonEmptyStr', 12, "12", [], "foobar", "" ],
+ [ 'IntArrayRef', 12, [12], {}, [17, 23], {} ],
+);
+
+plan tests => (@tests * 8) + 1;
+
+# new array ref so we can safely shift from it
+for my $data (map { [@$_] } @tests) {
+ my $type = shift @$data;
+
+ # Type name export
+ {
+ ok my $code = __PACKAGE__->can($type), "$type() was exported";
+ is $code->(), "TestLibrary::$type", "$type() returned correct type name";
+ }
+
+ # coercion handler export
+ {
+ my ($coerce, $coercion_result, $cannot_coerce) = map { shift @$data } 1 .. 3;
+ ok my $code = __PACKAGE__->can("to_$type"), "to_$type() coercion was exported";
+ is_deeply scalar $code->($coerce), $coercion_result, "to_$type() coercion works";
+ ok ! $code->($cannot_coerce), "to_$type() returns false on invalid value";
+ }
+
+ # type test handler
+ {
+ my ($valid, $invalid) = map { shift @$data } 1 .. 2;
+ ok my $code = __PACKAGE__->can("is_$type"), "is_$type() check was exported";
+ ok $code->($valid), "is_$type() check true on valid value";
+ ok ! $code->($invalid), "is_$type() check false on invalid value";
+ }
+}
+
+# coercion not available
+ok ! __PACKAGE__->can('to_TwentyThree'), "type without coercion doesn't have to_* helper";
--- /dev/null
+package TestLibrary;
+use warnings;
+use strict;
+
+use MooseX::TypeLibrary::Moose qw( Str ArrayRef Int );
+use MooseX::TypeLibrary
+ -declare => [qw( NonEmptyStr IntArrayRef TwentyThree )];
+
+subtype NonEmptyStr,
+ as Str,
+ where { length $_ },
+ message { 'Str must not be empty' };
+
+coerce NonEmptyStr,
+ from Int,
+ via { "$_" };
+
+subtype IntArrayRef,
+ as ArrayRef,
+ where { not grep { $_ !~ /^\d+$/ } @$_ },
+ message { 'ArrayRef contains non-Int value' };
+
+coerce IntArrayRef,
+ from Int,
+ via { [$_] };
+
+subtype TwentyThree,
+ as Int,
+ where { $_ == 23 },
+ message { 'Int is not 23' };
+
+1;
projects / gitmo/MooseX-Types.git / commitdiff