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