File Coverage

blib/lib/Test/Stream/Compare/Meta.pm
Criterion Covered Total %
statement 56 56 100.0
branch 12 12 100.0
condition 4 4 100.0
subroutine 16 16 100.0
pod 3 9 33.3
total 91 97 93.8


line stmt bran cond sub pod time code
1             package Test::Stream::Compare::Meta;
2 100     100   759 use strict;
  100         105  
  100         2219  
3 100     100   302 use warnings;
  100         109  
  100         1705  
4              
5 100     100   307 use Test::Stream::Delta();
  100         118  
  100         1398  
6              
7 100     100   314 use base 'Test::Stream::Compare';
  100         104  
  100         7072  
8 100     100   371 use Test::Stream::HashBase accessors => [qw/items/];
  100         125  
  100         612  
9              
10 100     100   431 use Carp qw/croak confess/;
  100         111  
  100         4097  
11 100     100   348 use Scalar::Util qw/reftype blessed/;
  100         112  
  100         36380  
12              
13             sub init {
14 419     419 0 390 my $self = shift;
15 419   100     1770 $self->{+ITEMS} ||= [];
16 419         869 $self->SUPER::init();
17             }
18              
19 2     2 1 9 sub name { '' }
20              
21             sub verify {
22 5     5 1 6 my $self = shift;
23 5         11 my %params = @_;
24 5 100       20 return $params{exists} ? 1 : 0;
25             }
26              
27             sub add_prop {
28 524     524 0 497 my $self = shift;
29 524         518 my ($name, $check) = @_;
30              
31 524 100       965 croak "prop name is required"
32             unless defined $name;
33              
34 523 100       777 croak "check is required"
35             unless defined $check;
36              
37 522         819 my $meth = "get_prop_$name";
38 522 100       1451 croak "'$name' is not a known property"
39             unless $self->can($meth);
40              
41 521         453 push @{$self->{+ITEMS}} => [$meth, $check, $name];
  521         1708  
42             }
43              
44             sub deltas {
45 424     424 1 404 my $self = shift;
46 424         782 my %params = @_;
47 424         564 my ($got, $convert, $seen) = @params{qw/got convert seen/};
48              
49 424         315 my @deltas;
50 424         482 my $items = $self->{+ITEMS};
51              
52 424         627 for my $set (@$items) {
53 543         873 my ($meth, $check, $name) = @$set;
54              
55 543         1078 $check = $convert->($check);
56              
57 543         1200 my $val = $self->$meth($got);
58              
59 543         1746 push @deltas => $check->run(
60             id => [META => $name],
61             got => $val,
62             convert => $convert,
63             seen => $seen,
64             );
65             }
66              
67 424         1031 return @deltas;
68             }
69              
70 424     424 0 1036 sub get_prop_blessed { blessed($_[1]) }
71              
72 13     13 0 30 sub get_prop_reftype { reftype($_[1]) }
73              
74 6     6 0 9 sub get_prop_this { $_[1] }
75              
76             sub get_prop_size {
77 3     3 0 5 my $self = shift;
78 3         3 my ($it) = @_;
79              
80 3   100     11 my $type = reftype($it) || '';
81              
82 3 100       7 return scalar @$it if $type eq 'ARRAY';
83 2 100       6 return scalar keys %$it if $type eq 'HASH';
84 1         1 return undef;
85             }
86              
87             1;
88              
89             __END__