refactored typelibrary (phaylon)

[gitmo/MooseX-Types.git] / lib / MooseX / TypeLibrary / Base.pm

diff --git a/lib/MooseX/TypeLibrary/Base.pm b/lib/MooseX/TypeLibrary/Base.pm
index 497737b..da140b5 100644 (file)
--- 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;