File Coverage

blib/lib/Template/Pure/DataContext.pm
Criterion Covered Total %
statement 38 75 50.6
branch 13 36 36.1
condition 5 8 62.5
subroutine 10 10 100.0
pod 0 3 0.0
total 66 132 50.0


line stmt bran cond sub pod time code
1 27     27   399 use strict;
  27         46  
  27         632  
2 27     27   86 use warnings;
  27         26  
  27         821  
3              
4             package Template::Pure::DataContext;
5            
6 27     27   89 use Scalar::Util 'blessed';
  27         31  
  27         1096  
7 27     27   8348 use Template::Pure::UndefObject;
  27         44  
  27         543  
8 27     27   108 use Data::Dumper;
  27         30  
  27         1521  
9              
10             use overload
11 4     4   605 q{""} => sub { shift->value },
12 27     27   93 'fallback' => 1;
  27         229  
  27         127  
13              
14             sub new {
15 352     352 0 486 my ($proto, $data_proto, $root) = @_;
16 352   66     814 my $class = ref($proto) || $proto;
17 352   66     1757 return bless +{
18             value => $data_proto,
19             root => ($root||$data_proto),
20             }, $class;
21             }
22              
23 284     284 0 683 sub value { shift->{value} }
24            
25             sub at {
26 214     214 0 299 my ($self, %at) = @_;
27 214 100       715 my $current = $at{absolute} ? $self->{root} : $self->{value};
28 214         172 foreach my $at(@{$at{path}}) {
  214         353  
29 303   50     528 my $key = $at->{key} || die "missing key";
30 303 100       717 if(blessed $current) {
    50          
31 172 100       406 if($current->can($key)) {
    50          
32 171         836 $current = $current->$key;
33             } elsif($at->{optional}) {
34 1         2 $current = undef;
35             } else {
36 0 0       0 if($current->isa('Template::Pure::DataProxy')) {
37 0 0       0 eval "use Moose (); 1" || die "Missing path '$key' in data context ". Dumper($current);
38 0         0 my @paths = ("--THIS CLASS--", map { $_ ."\t(hashkey)"} sort keys %{$current->{extra}});
  0         0  
  0         0  
39 0 0       0 if(ref $current->{data} eq 'HASH') {
40 0         0 push @paths, map { "$_\t(hashkey)" } sort keys %{$current->{data}};
  0         0  
  0         0  
41             } else {
42             # Assume its an object
43 0         0 my @methods = Class::MOP::Class->initialize(ref $current->{data})->get_method_list;
44             push @paths, map {
45 0         0 $_ ."\t(". ref($current->{data}) . ")";
46             } map {
47 0 0       0 ref $_ ? $_->name : $_;
  0         0  
48             } sort @methods;
49             }
50 0         0 my @all = Class::MOP::Class->initialize(ref $current->{data})->get_all_methods;
51 0 0       0 push @paths, '---ALL CLASSES---' if @all;
52             push @paths,
53 0         0 map { $_->name ."\t(". $_->package_name .")" }
54 0 0       0 grep { $_->package_name ne 'UNIVERSAL' }
  0         0  
55             sort @all if @all;
56              
57 0         0 die "Missing path '$key' in object ". ref($current) .", available:\n".join '', map { "\t$_\n"} grep { $_ ne 'new' } @paths;
  0         0  
  0         0  
58             } else {
59 0 0       0 eval "use Moose (); 1" || die "Missing path '$key' in data context ". Dumper($current);
60 0         0 my @paths;
61 0         0 my @methods = Class::MOP::Class->initialize(ref $current)->get_method_list;
62 0 0       0 push @paths, map { ref $_ ? $_->name : $_ } '---THIS CLASS---', @methods;
  0         0  
63 0         0 my @all = Class::MOP::Class->initialize(ref $current)->get_all_method_names;
64 0 0       0 push @paths, map { ref $_ ? $_->name : $_ } '---ALL CLASSES---', @all if @all;
  0 0       0  
65 0         0 die "Missing path '$key' in object ". ref($current) .", available:\n".join ',', map { "\t$_\n"} grep { $_ ne 'new' } @paths;
  0         0  
  0         0  
66             }
67             }
68             } elsif(ref $current eq 'HASH') {
69 131 100       197 if(exists $current->{$key}) {
    50          
70 129         147 $current = $current->{$key};
71             } elsif($at->{optional}) {
72 2         2 $current = undef;
73             } else {
74 0         0 my @paths = keys %{$current};
  0         0  
75 0         0 die "Missing path '$key' in Hashref, available:\n".join ',', map { "\t$_\n"} @paths;
  0         0  
76             }
77             } else {
78 0         0 die "Can't find path '$key' in ". Dumper $current;
79             }
80 303 100       15111 if($at->{maybe}) {
81 1         7 $current = Template::Pure::UndefObject->maybe($current);
82             }
83             }
84 214         391 return $self->new($current, $self->{root});
85             }
86              
87             1;