File Coverage

blib/lib/Text/Graph/DataSet.pm
Criterion Covered Total %
statement 50 50 100.0
branch 22 22 100.0
condition 7 9 77.7
subroutine 7 7 100.0
pod 0 1 0.0
total 86 89 96.6


line stmt bran cond sub pod time code
1             package Text::Graph::DataSet;
2              
3 8     8   22382 use strict;
  8         16  
  8         364  
4 8     8   44 use warnings;
  8         18  
  8         252  
5 8     8   849 use Moo;
  8         16709  
  8         81  
6 8     8   4810 use namespace::clean;
  8         13768  
  8         57  
7              
8             our $VERSION = '0.82';
9              
10             has values => (
11             is => 'ro',
12             reader => 'get_values',
13             );
14             has labels => (
15             is => 'ro',
16             reader => 'get_labels',
17             );
18              
19             #
20             # This routine is quite complicated to support the bizarre interface that I
21             # originally supported.
22             sub BUILDARGS
23             {
24 49     49 0 22723 my ( $class, @args ) = @_;
25 49 100       177 return { values => [], labels => [] } if !@args;
26 48         109 my ( $values, $labels, $hash ) = ( [], undef, undef );
27              
28 48 100       183 if( ref $args[0] eq ref [] )
    100          
29             {
30 42         72 $values = shift @args;
31 42 100       153 if( ref $args[0] eq ref [] )
32             {
33 36         67 $labels = shift @args;
34             }
35             }
36             elsif( ref $args[0] eq ref {} )
37             {
38 4         5 $hash = shift @args;
39 4 100       13 if( ref $args[0] eq ref [] )
40             {
41 1         2 $labels = shift @args;
42             }
43             }
44 48 100       192 die "Odd number of parameters to new.\n" if @args % 2 == 1;
45 47     1   271 my %real_args = ( sort => sub { sort @_ }, @args );
  1         9  
46 47         178 my $sortref = delete $real_args{sort};
47 47   100     219 $hash ||= delete $real_args{hash};
48 47 100       109 if( defined $hash )
49             {
50 5 100       9 if( $sortref )
51             {
52 4         11 my ( $pkg ) = caller;
53 4 100 50     24 $labels ||= [ $sortref->( keys %{$hash} ) ] if !$labels;
  3         13  
54             }
55             else
56             {
57 1   50     23 $labels ||= [ keys %{$hash} ];
  1         5  
58             }
59 5         27 $values = [ @{$hash}{ @{$labels} } ];
  5         22  
  5         7  
60 5         7 $hash = undef;
61             }
62 47   100     117 $labels ||= [];
63 47 100       49 push @{$labels}, ( '' ) x ( @{$values} - @{$labels} ) if @{$values} > @{$labels};
  7         14  
  7         14  
  7         34  
  47         83  
  47         119  
64 47         2144 return { values => $values, labels => $labels, %real_args };
65             }
66              
67             #
68             # Support the list or array ref original interface.
69             sub _list_or_ref
70             {
71 149     149   14324 my ( $orig, $self ) = @_;
72 149         420 my $val = $orig->( $self );
73 149 100       322 return wantarray ? @{$val} : $val;
  129         857  
74             }
75              
76             around 'get_values' => \&_list_or_ref;
77             around 'get_labels' => \&_list_or_ref;
78              
79             1;
80             __END__