Commit | Line | Data |
52d358e2 |
1 | package MooseX::Types::Util; |
e211870f |
2 | |
ef8b7b7a |
3 | #ABSTRACT: Common utility functions for the distribution |
e211870f |
4 | |
5 | use warnings; |
6 | use strict; |
be7d5c3e |
7 | use Scalar::Util 'blessed'; |
e211870f |
8 | |
9 | use base 'Exporter'; |
10 | |
11 | =head1 DESCRIPTION |
12 | |
13 | This package the exportable functions that many parts in |
52d358e2 |
14 | L<MooseX::Types> might need. |
e211870f |
15 | |
16 | =cut |
17 | |
5885c4f4 |
18 | our @EXPORT_OK = qw( filter_tags has_available_type_export ); |
e211870f |
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 | |
5885c4f4 |
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 |
be7d5c3e |
88 | unless blessed $sub && $sub->isa('MooseX::Types::EXPORTED_TYPE_CONSTRAINT'); |
5885c4f4 |
89 | |
90 | return $sub->(); |
91 | } |
92 | |
e211870f |
93 | =head1 SEE ALSO |
94 | |
52d358e2 |
95 | L<MooseX::Types::Moose>, L<Exporter> |
e211870f |
96 | |
e211870f |
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; |