File Coverage

blib/lib/Net/Google/Analytics/Row.pm
Criterion Covered Total %
statement 42 43 97.6
branch 4 4 100.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 57 58 98.2


line stmt bran cond sub pod time code
1             package Net::Google::Analytics::Row;
2             $Net::Google::Analytics::Row::VERSION = '3.05';
3 2     2   7 use strict;
  2         2  
  2         43  
4 2     2   6 use warnings;
  2         2  
  2         49  
5              
6             # ABSTRACT: Base class for Google Analytics API result rows
7              
8             BEGIN {
9 2     2   878 require Class::XSAccessor::Array;
10             }
11              
12             my $class_count = 0;
13             my %class_cache;
14              
15             # Dynamically generate a class with accessors
16             sub _gen_class {
17 4     4   7 my (undef, $column_headers) = @_;
18              
19             # Cache lookup
20 4         7 my $cache_key = join("\t", map { $_->{name} } @$column_headers);
  13         27  
21 4         13 my $class = $class_cache{$cache_key};
22 4 100       12 return $class if $class;
23              
24             # Generate unique package name
25 3         6 $class = "Net::Google::Analytics::Row_$class_count";
26 3         5 ++$class_count;
27              
28             {
29             # Set globals of new class
30 2     2   1542 no strict 'refs';
  2         3  
  2         283  
  3         5  
31 3         4 @{ "${class}::ISA" } = qw(Net::Google::Analytics::Row);
  3         44  
32 3         4 ${ "${class}::column_headers" } = $column_headers;
  3         13  
33             }
34              
35             # Create accessors
36 3         4 my %getters;
37 3         12 for (my $i = 0; $i < @$column_headers; ++$i) {
38 9         12 my $getter = 'get_' . $column_headers->[$i]->{name};
39 9         22 $getters{$getter} = $i;
40             }
41 3         22 Class::XSAccessor::Array->import(
42             class => $class,
43             getters => \%getters,
44             );
45              
46             # Store in cache
47 3         518 $class_cache{$cache_key} = $class;
48              
49 3         10 return $class;
50             }
51              
52             sub new {
53 17     17 1 18 my ($class, $row) = @_;
54 17         50 return bless($row, $class);
55             }
56              
57             sub _column_headers {
58 1     1   3 my $self = shift;
59 1         3 my $class = ref($self);
60 2     2   7 no strict 'refs';
  2         3  
  2         183  
61 1         1 return ${ "${class}::column_headers" };
  1         9  
62             }
63              
64             sub get {
65 1     1 1 2516 my ($self, $name) = @_;
66              
67 1         7 my $column_headers = $self->_column_headers;
68              
69 1         5 for (my $i = 0; $i < @$column_headers; ++$i) {
70 4 100       22 return $self->[$i] if $column_headers->[$i]->{name} eq $name;
71             }
72              
73 0           return undef;
74             }
75              
76             1;
77              
78             __END__