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   92120 use strict;
  13         22  
  13         391  
3 13     13   2446 use Acme::MetaSyntactic (); # do not export metaname and friends
  13         30  
  13         342  
4 13     13   6211 use Acme::MetaSyntactic::RemoteList;
  13         29  
  13         526  
5 13     13   89 use List::Util qw( shuffle );
  13         17  
  13         1220  
6 13     13   70 use Carp;
  13         26  
  13         2831  
7              
8             our @ISA = qw( Acme::MetaSyntactic::RemoteList );
9             our $VERSION = '1.001';
10              
11             sub init {
12 12     12 1 53077 my ($self, $data) = @_;
13 12         33 my $class = caller(0);
14              
15 12   66     149 $data ||= Acme::MetaSyntactic->load_data($class);
16 12 50       54 croak "The optional argument to init() must be a hash reference"
17             if ref $data ne 'HASH';
18              
19 13     13   86 no strict 'refs';
  13         17  
  13         399  
20 13     13   57 no warnings;
  13         940  
  13         4178  
21 12         55 ${"$class\::Theme"} = ( split /::/, $class )[-1];
  12         107  
22 12         22 @{"$class\::List"} = do { my %seen;
  12         92  
  12         16  
23 12         261 grep !$seen{$_}++, split /\s+/, $data->{names} };
24 12         68 *{"$class\::import"} = sub {
25 6     6   53 my $callpkg = caller(0);
26 6         10 my $theme = ${"$class\::Theme"};
  6         23  
27 6         19 my $meta = $class->new();
28 6     1   29 *{"$callpkg\::meta$theme"} = sub { $meta->name(@_) };
  6         1701  
  1         5  
29 12         77 };
30 12         81 ${"$class\::meta"} = $class->new();
  12         93  
31             }
32              
33             sub name {
34 31     31 1 2806 my ( $self, $count ) = @_;
35 31         56 my $class = ref $self;
36              
37 31 50       76 if( ! $class ) { # called as a class method!
38 0         0 $class = $self;
39 13     13   73 no strict 'refs';
  13         23  
  13         733  
40 0         0 $self = ${"$class\::meta"};
  0         0  
41             }
42              
43 31 100 100     167 if( defined $count && $count == 0 ) {
44 13     13   135 no strict 'refs';
  13         20  
  13         1147  
45             return
46 13 100       39 wantarray ? shuffle @{"$class\::List"} : scalar @{"$class\::List"};
  12         338  
  1         9  
47             }
48              
49 18   100     85 $count ||= 1;
50 18         71 my $list = $self->{cache};
51             {
52 13     13   103 no strict 'refs';
  13         16  
  13         2237  
  18         20  
53 18 100       20 if (@{"$class\::List"}) {
  18         92  
54 16         47 push @$list, shuffle @{"$class\::List"} while @$list < $count;
  14         281  
55             }
56             }
57 18         131 splice( @$list, 0, $count );
58             }
59              
60             sub new {
61 42     42 1 501 my $class = shift;
62              
63 42         331 bless { cache => [] }, $class;
64             }
65              
66             sub theme {
67 2   66 2 1 10 my $class = ref $_[0] || $_[0];
68 13     13   70 no strict 'refs';
  13         22  
  13         834  
69 2         3 return ${"$class\::Theme"};
  2         21  
70             }
71              
72             1;
73              
74             __END__