lib/MooseX/Types/Util.pm

   1 package MooseX::Types::Util;
   2 our $VERSION = "0.26";
   3
   4 =head1 NAME
   5
   6 MooseX::Types::Util - Common utility functions for the module
   7
   8 =cut
   9
  10 use warnings;
  11 use strict;
  12 use Scalar::Util 'blessed';
  13
  14 use base 'Exporter';
  15
  16 =head1 DESCRIPTION
  17
  18 This package the exportable functions that many parts in
  19 L<MooseX::Types> might need.
  20
  21 =cut
  22
  23 our @EXPORT_OK = qw( filter_tags has_available_type_export );
  24
  25 =head1 FUNCTIONS
  26
  27 =head2 filter_tags
  28
  29 Takes a list and returns two references. The first is a hash reference
  30 containing the tags as keys and the number of their appearance as values.
  31 The second is an array reference containing all other elements.
  32
  33 =cut
  34
  35 sub filter_tags {
  36     my (@list) = @_;
  37     my (%tags, @other);
  38     for (@list) {
  39         if (/^:(.*)$/) {
  40             $tags{ $1 }++;
  41             next;
  42         }
  43         push @other, $_;
  44     }
  45     return \%tags, \@other;
  46 }
  47
  48 =head2 has_available_type_export
  49
  50   TypeConstraint | Undef = has_available_type_export($package, $name);
  51
  52 This function allows you to introspect if a given type export is available
  53 I<at this point in time>. This means that the C<$package> must have imported
  54 a typeconstraint with the name C<$name>, and it must be still in its symbol
  55 table.
  56
  57 Two arguments are expected:
  58
  59 =over 4
  60
  61 =item $package
  62
  63 The name of the package to introspect.
  64
  65 =item $name
  66
  67 The name of the type export to introspect.
  68
  69 =back
  70
  71 B<Note> that the C<$name> is the I<exported> name of the type, not the declared
  72 one. This means that if you use L<Sub::Exporter>s functionality to rename an import
  73 like this:
  74
  75   use MyTypes Str => { -as => 'MyStr' };
  76
  77 you would have to introspect this type like this:
  78
  79   has_available_type_export $package, 'MyStr';
  80
  81 The return value will be either the type constraint that belongs to the export
  82 or an undefined value.
  83
  84 =cut
  85
  86 sub has_available_type_export {
  87     my ($package, $name) = @_;
  88
  89     my $sub = $package->can($name)
  90         or return undef;
  91
  92     return undef
  93         unless blessed $sub && $sub->isa('MooseX::Types::EXPORTED_TYPE_CONSTRAINT');
  94
  95     return $sub->();
  96 }
  97
  98 =head1 SEE ALSO
  99
 100 L<MooseX::Types::Moose>, L<Exporter>
 101
 102 =head1 AUTHOR
 103
 104 See L<MooseX::Types/AUTHOR>.
 105
 106 =head1 LICENSE
 107
 108 This program is free software; you can redistribute it and/or modify
 109 it under the same terms as perl itself.
 110
 111 =cut
 112
 113 1;