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   191867 use strict;
  13         62  
  13         315  
3 13     13   1423 use Acme::MetaSyntactic (); # do not export metaname and friends
  13         29  
  13         248  
4 13     13   3773 use Acme::MetaSyntactic::RemoteList;
  13         34  
  13         445  
5 13     13   90 use List::Util qw( shuffle );
  13         25  
  13         1041  
6 13     13   75 use Carp;
  13         24  
  13         1413  
7              
8             our @ISA = qw( Acme::MetaSyntactic::RemoteList );
9             our $VERSION = '1.001';
10              
11             sub init {
12 12     12 1 36765 my ($self, $data) = @_;
13 12         39 my $class = caller(0);
14              
15 12   66     116 $data ||= Acme::MetaSyntactic->load_data($class);
16 12 50       51 croak "The optional argument to init() must be a hash reference"
17             if ref $data ne 'HASH';
18              
19 13     13   84 no strict 'refs';
  13         27  
  13         322  
20 13     13   68 no warnings;
  13         26  
  13         3208  
21 12         41 ${"$class\::Theme"} = ( split /::/, $class )[-1];
  12         79  
22 12         29 @{"$class\::List"} = do { my %seen;
  12         70  
  12         42  
23 12         215 grep !$seen{$_}++, split /\s+/, $data->{names} };
24 12         63 *{"$class\::import"} = sub {
25 6     6   59 my $callpkg = caller(0);
26 6         15 my $theme = ${"$class\::Theme"};
  6         28  
27 6         22 my $meta = $class->new();
28 6     1   38 *{"$callpkg\::meta$theme"} = sub { $meta->name(@_) };
  6         1343  
  1         5  
29 12         65 };
30 12         72 ${"$class\::meta"} = $class->new();
  12         85  
31             }
32              
33             sub name {
34 30     30 1 2240 my ( $self, $count ) = @_;
35 30         139 my $class = ref $self;
36              
37 30 50       77 if( ! $class ) { # called as a class method!
38 0         0 $class = $self;
39 13     13   92 no strict 'refs';
  13         24  
  13         837  
40 0         0 $self = ${"$class\::meta"};
  0         0  
41             }
42              
43 30 100 100     140 if( defined $count && $count == 0 ) {
44 13     13   70 no strict 'refs';
  13         26  
  13         918  
45             return
46 12 100       41 wantarray ? shuffle @{"$class\::List"} : scalar @{"$class\::List"};
  11         240  
  1         5  
47             }
48              
49 18   100     54 $count ||= 1;
50 18         54 my $list = $self->{cache};
51             {
52 13     13   80 no strict 'refs';
  13         24  
  13         1754  
  18         27  
53 18 100       21 if (@{"$class\::List"}) {
  18         71  
54 16         39 push @$list, shuffle @{"$class\::List"} while @$list < $count;
  14         233  
55             }
56             }
57 18         117 splice( @$list, 0, $count );
58             }
59              
60             sub new {
61 41     41 1 111 my $class = shift;
62              
63 41         158 bless { cache => [] }, $class;
64             }
65              
66             sub theme {
67 2   66 2 1 9 my $class = ref $_[0] || $_[0];
68 13     13   75 no strict 'refs';
  13         24  
  13         610  
69 2         3 return ${"$class\::Theme"};
  2         15  
70             }
71              
72             1;
73              
74             __END__