lib/MooseX/Types/Util.pm

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