File Coverage

blib/lib/Acme/MetaSyntactic/List.pm
Criterion Covered Total %
statement 74 77 96.1
branch 8 10 80.0
condition 9 11 81.8
subroutine 17 17 100.0
pod 4 4 100.0
total 112 119 94.1


line stmt bran cond sub pod time code
1             package Acme::MetaSyntactic::List;
2 13     13   305974 use strict;
  13         65  
  13         412  
3 13     13   2604 use Acme::MetaSyntactic (); # do not export metaname and friends
  13         35  
  13         305  
4 13     13   6042 use Acme::MetaSyntactic::RemoteList;
  13         39  
  13         486  
5 13     13   91 use List::Util qw( shuffle );
  13         29  
  13         1259  
6 13     13   87 use Carp;
  13         28  
  13         1780  
7              
8             our @ISA = qw( Acme::MetaSyntactic::RemoteList );
9             our $VERSION = '1.001';
10              
11             sub init {
12 12     12 1 56382 my ($self, $data) = @_;
13 12         65 my $class = caller(0);
14              
15 12   66     217 $data ||= Acme::MetaSyntactic->load_data($class);
16 12 50       90 croak "The optional argument to init() must be a hash reference"
17             if ref $data ne 'HASH';
18              
19 13     13   137 no strict 'refs';
  13         40  
  13         442  
20 13     13   74 no warnings;
  13         34  
  13         4314  
21 12         65 ${"$class\::Theme"} = ( split /::/, $class )[-1];
  12         99  
22 12         29 @{"$class\::List"} = do { my %seen;
  12         124  
  12         70  
23 12         338 grep !$seen{$_}++, split /\s+/, $data->{names} };
24 12         86 *{"$class\::import"} = sub {
25 6     6   54 my $callpkg = caller(0);
26 6         13 my $theme = ${"$class\::Theme"};
  6         27  
27 6         20 my $meta = $class->new();
28 6     1   37 *{"$callpkg\::meta$theme"} = sub { $meta->name(@_) };
  6         1922  
  1         5  
29 12         104 };
30 12         104 ${"$class\::meta"} = $class->new();
  12         115  
31             }
32              
33             sub name {
34 30     30 1 2777 my ( $self, $count ) = @_;
35 30         68 my $class = ref $self;
36              
37 30 50       91 if( ! $class ) { # called as a class method!
38 0         0 $class = $self;
39 13     13   107 no strict 'refs';
  13         57  
  13         774  
40 0         0 $self = ${"$class\::meta"};
  0         0  
41             }
42              
43 30 100 100     175 if( defined $count && $count == 0 ) {
44 13     13   93 no strict 'refs';
  13         43  
  13         1264  
45             return
46 12 100       51 wantarray ? shuffle @{"$class\::List"} : scalar @{"$class\::List"};
  11         317  
  1         10  
47             }
48              
49 18   100     73 $count ||= 1;
50 18         72 my $list = $self->{cache};
51             {
52 13     13   90 no strict 'refs';
  13         27  
  13         2665  
  18         29  
53 18 100       33 if (@{"$class\::List"}) {
  18         95  
54 16         84 push @$list, shuffle @{"$class\::List"} while @$list < $count;
  14         318  
55             }
56             }
57 18         160 splice( @$list, 0, $count );
58             }
59              
60             sub new {
61 41     41 1 126 my $class = shift;
62              
63 41         193 bless { cache => [] }, $class;
64             }
65              
66             sub theme {
67 2   66 2 1 12 my $class = ref $_[0] || $_[0];
68 13     13   99 no strict 'refs';
  13         28  
  13         870  
69 2         4 return ${"$class\::Theme"};
  2         16  
70             }
71              
72             1;
73              
74             __END__