local-lib5/lib/perl5/MooseX/Types/Util.pm

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