From: phaylon <phaylon@3efe9002-19ed-0310-8735-a98156148065>
Date: Sat, 24 Mar 2007 22:24:56 +0000 (+0000)
Subject: refactored typelibrary (phaylon)
X-Git-Tag: 0.06~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types.git;a=commitdiff_plain;h=e211870f5f4f39a7f477a36d44b1e68e95ae2acc

refactored typelibrary (phaylon)
---

diff --git a/lib/MooseX/TypeLibrary.pm b/lib/MooseX/TypeLibrary.pm
index 6dedb27..6f00856 100644
--- a/lib/MooseX/TypeLibrary.pm
+++ b/lib/MooseX/TypeLibrary.pm
@@ -12,7 +12,9 @@ use strict;
 use Sub::Uplevel;
 use Moose::Util::TypeConstraints;
 use MooseX::TypeLibrary::Base;
-use Sub::Install    qw( install_sub );
+use MooseX::TypeLibrary::Util           qw( filter_tags );
+use MooseX::TypeLibrary::UndefinedType;
+use Sub::Install                        qw( install_sub );
 use namespace::clean;
 
 our $VERSION = 0.01;
@@ -159,6 +161,12 @@ L<MooseX::TypeLibrary::Moose>.
 
 =head2 import
 
+Installs the L<MooseX::TypeLibrary::Base> class into the caller and 
+exports types according to the specification described in 
+L</"LIBRARY DEFINITION">. This will continue to 
+L<Moose::Util::TypeConstraints>' C<import> method to export helper
+functions you will need to declare your types.
+
 =cut
 
 sub import {
@@ -171,8 +179,10 @@ sub import {
     }
 
     # generate predeclared type helpers
-    if (my @declare = @{ $args{ -declare } || [] }) {
-        for my $type (@declare) {
+    if (my @orig_declare = @{ $args{ -declare } || [] }) {
+        my ($tags, $declare) = filter_tags @orig_declare;
+
+        for my $type (@$declare) {
             $callee->add_type($type);
             $callee->export_type_into(
                 $callee, $type, 
@@ -190,15 +200,25 @@ sub import {
 
 =head2 type_export_generator
 
+Generate a type export, e.g. C<Int()>. This will return either a
+L<Moose::Meta::TypeConstraint> object, or alternatively a
+L<MooseX::TypeLibrary::UndefinedType> object if the type was not
+yet defined.
+
 =cut
 
 sub type_export_generator {
     my ($class, $type, $full) = @_;
-    return sub { $full };
+    return sub { 
+        return find_type_constraint($full)
+            || MooseX::TypeLibrary::UndefinedType->new($full);
+    };
 }
 
 =head2 coercion_export_generator
 
+This generates a coercion handler function, e.g. C<to_Int($value)>. 
+
 =cut
 
 sub coercion_export_generator {
@@ -219,6 +239,8 @@ sub coercion_export_generator {
 
 =head2 check_export_generator
 
+Generates a constraint check closure, e.g. C<is_Int($value)>.
+
 =cut
 
 sub check_export_generator {
@@ -233,6 +255,13 @@ sub check_export_generator {
     }
 }
 
+=head1 CAVEATS
+
+A library makes the types quasi-unique by prefixing their names with (by
+default) the library package name. If you're only using the type handler
+functions provided by MooseX::TypeLibrary, you shouldn't ever have to use
+a type's actual full name.
+
 =head1 SEE ALSO
 
 L<Moose>, L<Moose::Util::TypeConstraints>, L<MooseX::TypeLibrary::Moose>
diff --git a/lib/MooseX/TypeLibrary/Base.pm b/lib/MooseX/TypeLibrary/Base.pm
index 497737b..da140b5 100644
--- a/lib/MooseX/TypeLibrary/Base.pm
+++ b/lib/MooseX/TypeLibrary/Base.pm
@@ -1,30 +1,68 @@
 package MooseX::TypeLibrary::Base;
+
+=head1 NAME
+
+MooseX::TypeLibrary::Base - Type library base class
+
+=cut
+
 use warnings;
 use strict;
 
-#use Smart::Comments;
-use Sub::Install    qw( install_sub );
-use Carp            qw( croak );
+use Sub::Install                    qw( install_sub );
+use Carp                            qw( croak );
+use MooseX::TypeLibrary::Util       qw( filter_tags );
 use Moose::Util::TypeConstraints;
 use namespace::clean;
 
+=head1 DESCRIPTION
+
+You normally won't need to interact with this class by yourself. It is
+merely a collection of functionality that type libraries need to 
+interact with moose and the rest of the L<MooseX::TypeLibrary> module.
+
+=cut
+
 my $UndefMsg = q{Unable to find type '%s' in library '%s'};
 
+=head1 METHODS
+
+=cut
+
+=head2 import
+
+Provides the import mechanism for your library. See 
+L<MooseX::TypeLibrary/"LIBRARY USAGE"> for syntax details on this.
+
+=cut
+
 sub import {
-    my ($class, @types) = @_;
+    my ($class, @orig_types) = @_;
+
+    # separate tags from types
+    my ($tags, $types) = filter_tags @orig_types;
 
-    # flatten out tags
-    @types = map { $_ eq ':all' ? $class->type_names : $_ } @types;
+    # :all replaces types with full list
+    @$types = $class->type_names if $tags->{all};
 
   TYPE:
     # export all requested types
-    for my $type (@types) {
+    for my $type (@$types) {
         $class->export_type_into(
-            scalar(caller), $type, sprintf $UndefMsg, $type, $class );
+            scalar(caller), 
+            $type, 
+            sprintf($UndefMsg, $type, $class),
+        );
     }
     return 1;
 }
 
+=head2 export_type_into
+
+Exports one specific type into a target package.
+
+=cut
+
 sub export_type_into {
     my ($class, $target, $type, $undef_msg, %args) = @_;
     
@@ -49,19 +87,27 @@ sub export_type_into {
     });
 
     # only install to_Type coercion handler if type can coerce
-    return 1 unless $args{ -full } or $tobj->has_coercion;
+    # or if we want to provide them anyway, e.g. declarations
+    if ($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",
-    });
+        # install to_Type coercion handler
+        install_sub({
+            code => MooseX::TypeLibrary->coercion_export_generator(
+                        $type, $full, $undef_msg ),
+            into => $target,
+            as   => "to_$type",
+        });
+    }
 
     return 1;
 }
 
+=head2 get_type
+
+This returns a type from the library's store by its name.
+
+=cut
+
 sub get_type {
     my ($class, $type) = @_;
 
@@ -73,6 +119,12 @@ sub get_type {
     return $class->type_storage->{ $type };
 }
 
+=head2 type_names
+
+Returns a list of all known types by their name.
+
+=cut
+
 sub type_names {
     my ($class) = @_;
 
@@ -80,6 +132,12 @@ sub type_names {
     return keys %{ $class->type_storage };
 }
 
+=head2 add_type
+
+Adds a new type to the library.
+
+=cut
+
 sub add_type {
     my ($class, $type) = @_;
 
@@ -87,6 +145,13 @@ sub add_type {
     $class->type_storage->{ $type } = "${class}::${type}";
 }
 
+=head2 has_type
+
+Returns true or false depending on if this library knows a type by that
+name.
+
+=cut
+
 sub has_type {
     my ($class, $type) = @_;
 
@@ -94,6 +159,14 @@ sub has_type {
     return ! ! $class->type_storage->{ $type };
 }
 
+=head2 type_storage
+
+Returns the library's type storage hash reference. You shouldn't use this
+method directly unless you know what you are doing. It is not an internal
+method because overriding it makes virtual libraries very easy.
+
+=cut
+
 sub type_storage {
     my ($class) = @_;
 
@@ -103,4 +176,20 @@ sub type_storage {
     }
 }
 
+=head1 SEE ALSO
+
+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;
diff --git a/lib/MooseX/TypeLibrary/Moose.pm b/lib/MooseX/TypeLibrary/Moose.pm
index 2254cb7..3b5755a 100644
--- a/lib/MooseX/TypeLibrary/Moose.pm
+++ b/lib/MooseX/TypeLibrary/Moose.pm
@@ -1,4 +1,11 @@
 package MooseX::TypeLibrary::Moose;
+
+=head1 NAME
+
+MooseX::TypeLibrary::Moose - Types shipped with L<Moose>
+
+=cut
+
 use warnings;
 use strict;
 
@@ -6,12 +13,71 @@ use MooseX::TypeLibrary;
 use Moose::Util::TypeConstraints ();
 use namespace::clean;
 
+=head1 SYNOPSIS
+
+  package Foo;
+  use Moose;
+  use MooseX::TypeLibrary::Moose qw( Int Str );
+  use Carp qw( croak );
+
+  has 'name',
+    is  => 'rw',
+    isa => Str;
+
+  has 'id',
+    is  => 'rw',
+    isa => Int;
+
+  sub add {
+      my ($self, $x, $y) = @_;
+      croak 'First arg not an Int'  unless is_Int($x);
+      croak 'Second arg not an Int' unless is_Int($y);
+      return $x + $y;
+  }
+
+  1;
+
+=head1 DESCRIPTION
+
+This package contains a virtual library for L<MooseX::TypeLibrary> that
+is able to export all types known to L<Moose>. See L<MooseX::TypeLibrary>
+for general usage information.
+
+=cut
+
 # all available builtin types as short and long name
 my %BuiltIn_Storage 
   = map { ($_) x 2 } 
     Moose::Util::TypeConstraints->list_all_builtin_type_constraints;
 
+=head1 METHODS
+
+=head2 type_storage
+
+Overrides L<MooseX::TypeLibrary::Base>' C<type_storage> to provide a hash
+reference containing all built-in L<Moose> types.
+
+=cut
+
 # use prepopulated builtin hash as type storage
 sub type_storage { \%BuiltIn_Storage }
 
+=head1 SEE ALSO
+
+L<MooseX::TypeLibrary::Moose>,
+L<Moose>, 
+L<Moose::Util::TypeConstraints>
+
+=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;
diff --git a/lib/MooseX/TypeLibrary/UndefinedType.pm b/lib/MooseX/TypeLibrary/UndefinedType.pm
new file mode 100644
index 0000000..3bb4ca6
--- /dev/null
+++ b/lib/MooseX/TypeLibrary/UndefinedType.pm
@@ -0,0 +1,60 @@
+package MooseX::TypeLibrary::UndefinedType;
+
+=head1 NAME
+
+MooseX::TypeLibrary::UndefinedType - Represents a not yet defined type
+
+=cut
+
+use warnings;
+use strict;
+
+use overload '""'     => sub { shift->name },
+             fallback => 1;
+
+=head1 DESCRIPTION
+
+Whenever a type handle function (e.g. C<Int()> can't find a type 
+constraint under it's full name, it assumes it has not yet been defined.
+It will then return an instance of this class, handling only 
+stringification, name and possible identification of undefined types.
+
+=head1 METHODS
+
+=head2 new
+
+Takes a full type name as argument and returns an instance of this
+class.
+
+=cut
+
+sub new { bless { name => $_[1] }, $_[0] }
+
+=head2 name
+
+Returns the stored type name.
+
+=cut
+
+sub name { $_[0]->{name} }
+
+=head1 SEE ALSO
+
+L<MooseX::TypeLibrary::Moose>,
+L<Moose::Util::TypeConstraints>, 
+L<Moose::Meta::TypeConstraint>
+
+=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;
diff --git a/lib/MooseX/TypeLibrary/Util.pm b/lib/MooseX/TypeLibrary/Util.pm
new file mode 100644
index 0000000..85e780f
--- /dev/null
+++ b/lib/MooseX/TypeLibrary/Util.pm
@@ -0,0 +1,62 @@
+package MooseX::TypeLibrary::Util;
+
+=head1 NAME
+
+MooseX::TypeLibrary::Util - Common utility functions for the module
+
+=cut
+
+use warnings;
+use strict;
+
+use base 'Exporter';
+
+=head1 DESCRIPTION
+
+This package the exportable functions that many parts in 
+L<MooseX::TypeLibrary> might need.
+
+=cut
+
+our @EXPORT_OK = qw( filter_tags );
+
+=head1 FUNCTIONS
+
+=head2 filter_tags
+
+Takes a list and returns two references. The first is a hash reference
+containing the tags as keys and the number of their appearance as values.
+The second is an array reference containing all other elements.
+
+=cut
+
+sub filter_tags {
+    my (@list) = @_;
+    my (%tags, @other);
+    for (@list) {
+        if (/^:(.*)$/) {
+            $tags{ $1 }++;
+            next;
+        }
+        push @other, $_;
+    }
+    return \%tags, \@other;
+}
+
+=head1 SEE ALSO
+
+L<MooseX::TypeLibrary::Moose>, L<Exporter>
+
+=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;