File Coverage

blib/lib/Declare/Constraints/Simple/Library/Exportable.pm
Criterion Covered Total %
statement 67 67 100.0
branch 21 24 87.5
condition n/a
subroutine 12 12 100.0
pod n/a
total 100 103 97.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Declare::Constraints::Simple::Library::Exportable - Export Facilities
4              
5             =cut
6              
7             package Declare::Constraints::Simple::Library::Exportable;
8 13     13   84 use warnings;
  13         26  
  13         382  
9 13     13   69 use strict;
  13         24  
  13         411  
10              
11 13     13   13252 use Carp::Clan qw(^Declare::Constraints::Simple);
  13         82392  
  13         358  
12 13     13   18251 use Class::Inspector;
  13         77289  
  13         715  
13              
14 13     13   15862 use aliased 'Declare::Constraints::Simple::Library::Base' => 'LibraryBase';
  13         42645  
  13         119  
15             sub Library () { 'Declare::Constraints::Simple::Library' }
16              
17             =head1 DESCRIPTION
18              
19             This contains the constraint export logic of the module.
20              
21             =head1 METHODS
22              
23             =head2 import($flag, @args)
24              
25             use ExportableModule->All;
26              
27             # or
28             use ExportableModule-Only => qw(Constraint1 ...);
29              
30             # or
31             use ExportableModule-Library;
32              
33             Exports the constraints to the calling namespace. This includes all
34             libraries in L, that package itself
35             (providing all default constraints) or L
36             itself as a shortcut.
37              
38             Possible flags are
39              
40             =over
41              
42             =item All
43              
44             Imports all constraints registered in the class and its base classes.
45              
46             =item Only
47              
48             use Declare::Constraints::Simple::Library::Scalar-Only => 'HasLength';
49              
50             The above line would only import the C constraints from the
51             C default library. Note however, that you could also just have
52             said
53              
54             use Declare::Constraints::Simple-Only => 'HasLength';
55              
56             as both C<::Simple> and C<::Simple::Library> work on all default
57             libraries.
58              
59             =item Library
60              
61             You can use this to define your own constraint library. For more
62             information, see L.
63              
64             =back
65              
66             =cut
67              
68             sub import {
69 113     113   809 my ($class, $flag, @args) = @_;
70 113 100       663 return unless $flag;
71              
72 111         805 my $handle_map = $class->_build_handle_map;
73 111         250 my $target = scalar(caller);
74            
75 111 100       1106 if ($flag =~ /^-?all$/i) {
    100          
    50          
76 5         49 $class->_export_all($target, $handle_map);
77             }
78             elsif ($flag =~ /^-?only$/i) {
79 8         86 $class->_export_these($target, $handle_map, @args);
80             }
81             elsif ($flag =~ /^-?library$/i) {
82 98         681 LibraryBase->install_into($target);
83             }
84              
85 111         77644 1;
86             }
87              
88             =head2 _build_handle_map()
89              
90             Internal method to build constraint-to-class mappings.
91              
92             =cut
93              
94             sub _build_handle_map {
95 111     111   209 my ($class) = @_;
96              
97 111 100       318 if ($class eq 'Declare::Constraints::Simple') {
98 109         184 $class = Library;
99             }
100              
101 111 100       273 if ($class eq Library) {
102 109 100       839 unless (Class::Inspector->loaded(Library)) {
103 12         1202 require Class::Inspector->filename(Library);
104             }
105             }
106              
107 111         10051 my (%seen, %handle_map, @walk, %walked);
108 111         147 @walk = do {
109 13     13   9987 no strict 'refs';
  13         27  
  13         1950  
110 111         140 ($class, @{$class . '::ISA'});
  111         598  
111             };
112              
113 111         6269 while (my $w = shift @walk) {
114              
115 463 100       1310 next if $walked{$w};
116 264         550 $walked{$w} = 1;
117              
118 264 100       9838 if ($w->can('fetch_constraint_declarations')) {
119 153         688 my @decl = $w->fetch_constraint_declarations;
120 153         337 for my $d (@decl) {
121 531 100       1001 next if exists $seen{$d};
122 530         751 $seen{$d} = 1;
123 530         1005 $handle_map{$d} = $w;
124             }
125             }
126              
127 261         1133 push @walk,
128             grep { not exists $walked{$_} }
129 13     13   67 do { no strict 'refs' ; @{$w . '::ISA'} };
  13         29  
  13         7105  
  264         414  
  264         284  
  264         1294  
130             }
131              
132 111         634 return \%handle_map;
133             }
134              
135             =head2 _export_all($target, $handle_map)
136              
137             Internal method. Exports all handles in C<$handle_map> into the C<$target>
138             namespace.
139              
140             =cut
141              
142             sub _export_all {
143 5     5   12 my ($class, $target, $handle_map) = @_;
144 5         77 return $class->_export_these($target, $handle_map, keys %$handle_map);
145             }
146              
147             =head2 _export_these($target, $handle_map, @constraints)
148              
149             Internal method. Exports all C<@constraints> from C<$handle_map> into the
150             C<$target> namespace.
151              
152             =cut
153              
154             sub _export_these {
155 13     13   88 my ($class, $target, $handle_map, @decl) = @_;
156              
157 13         38 for my $d (@decl) {
158 220 50       611 my $handle = $handle_map->{$d}
159             or croak "Constraint '$d' cannot be found in $class";
160 220         924 my $gen = $handle_map->{$d}->fetch_constraint_generator($d);
161              
162 220 50       607 croak sprintf
163             'Constraint Generator for $s in %s did not return a closure',
164             $d, $handle_map->{$d}
165             unless ref($gen) eq 'CODE';
166              
167 13     13   70 { no strict 'refs';
  13         26  
  13         1809  
  220         221  
168 220         222 *{$target . '::' . $d} = $gen;
  220         1349  
169             }
170             }
171             }
172              
173             =head1 SEE ALSO
174              
175             L, L,
176             L
177              
178             =head1 AUTHOR
179              
180             Robert 'phaylon' Sedlacek Cphaylon@dunkelheit.atE>
181              
182             =head1 LICENSE AND COPYRIGHT
183              
184             This module is free software, you can redistribute it and/or modify it
185             under the same terms as perl itself.
186              
187             =cut
188              
189             1;