File Coverage

blib/lib/Object/InterfaceType.pm
Criterion Covered Total %
statement 30 30 100.0
branch 7 8 87.5
condition 3 5 60.0
subroutine 7 7 100.0
pod 1 1 100.0
total 48 51 94.1


line stmt bran cond sub pod time code
1             package Object::InterfaceType;
2 2     2   1024 use strict;
  2         4  
  2         77  
3 2     2   10 use warnings;
  2         3  
  2         57  
4 2     2   10 use base 'Exporter';
  2         2  
  2         314  
5             our @EXPORT = 'interface_type';
6             our $VERSION = '0.01';
7              
8 2     2   12 use Scalar::Util 'blessed';
  2         2  
  2         1216  
9              
10             sub interface_type {
11 6     6 1 57 my($typename, $methods) = @_;
12 6         9 my $caller = caller(0);
13 6 100       14 if (ref($typename) eq 'ARRAY') {
14 3         5 $methods = $typename;
15 3         5 $typename = undef;
16             }
17 6 50 33     34 $methods = [] unless $methods && ref($methods) eq 'ARRAY';
18              
19             my $code = sub {
20 22     22   90 my $class = blessed $_[0];
21 22 100       57 return unless $class;
22 18   100     18 $class->can($_) or return for @{ $methods };
  18         139  
23 12         51 return 1;
24 6         24 };
25              
26 6 100       18 return $code unless defined $typename;
27 2     2   223 no strict 'refs';
  2         3  
  2         385  
28 3         3 *{"$caller\::is_$typename"} = $code;
  3         16  
29             }
30              
31             1;
32             __END__