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   1029 use strict;
  100         186  
  100         2501  
3 100     100   493 use warnings;
  100         189  
  100         2496  
4              
5 100     100   567 use Test::Stream::Delta;
  100         193  
  100         2141  
6              
7 100     100   485 use Test::Stream::Compare;
  100         196  
  100         673  
8             use Test::Stream::HashBase(
9 100         902 base => 'Test::Stream::Compare',
10             accessors => [qw/items/],
11 100     100   566 );
  100         268  
12              
13 100     100   551 use Carp qw/croak confess/;
  100         186  
  100         5311  
14 100     100   511 use Scalar::Util qw/reftype blessed/;
  100         189  
  100         54375  
15              
16             sub init {
17 409     409 0 601 my $self = shift;
18 409   100     1958 $self->{+ITEMS} ||= [];
19 409         1267 $self->SUPER::init();
20             }
21              
22 2     2 1 13 sub name { '' }
23              
24             sub verify {
25 5     5 1 11 my $self = shift;
26 5         15 my %params = @_;
27 5 100       30 return $params{exists} ? 1 : 0;
28             }
29              
30             sub add_prop {
31 514     514 0 688 my $self = shift;
32 514         836 my ($name, $check) = @_;
33              
34 514 100       1291 croak "prop name is required"
35             unless defined $name;
36              
37 513 100       1088 croak "check is required"
38             unless defined $check;
39              
40 512         1053 my $meth = "get_prop_$name";
41 512 100       1938 croak "'$name' is not a known property"
42             unless $self->can($meth);
43              
44 511         712 push @{$self->{+ITEMS}} => [$meth, $check, $name];
  511         2345  
45             }
46              
47             sub deltas {
48 414     414 1 554 my $self = shift;
49 414         1283 my %params = @_;
50 414         753 my ($got, $convert, $seen) = @params{qw/got convert seen/};
51              
52 414         478 my @deltas;
53 414         660 my $items = $self->{+ITEMS};
54              
55 414         781 for my $set (@$items) {
56 533         1213 my ($meth, $check, $name) = @$set;
57              
58 533         1454 $check = $convert->($check);
59              
60 533         1770 my $val = $self->$meth($got);
61              
62 533         2430 push @deltas => $check->run(
63             id => [META => $name],
64             got => $val,
65             convert => $convert,
66             seen => $seen,
67             );
68             }
69              
70 414         1484 return @deltas;
71             }
72              
73 414     414 0 1372 sub get_prop_blessed { blessed($_[1]) }
74              
75 13     13 0 46 sub get_prop_reftype { reftype($_[1]) }
76              
77 6     6 0 15 sub get_prop_this { $_[1] }
78              
79             sub get_prop_size {
80 3     3 0 4 my $self = shift;
81 3         5 my ($it) = @_;
82              
83 3   100     15 my $type = reftype($it) || '';
84              
85 3 100       11 return scalar @$it if $type eq 'ARRAY';
86 2 100       7 return scalar keys %$it if $type eq 'HASH';
87 1         3 return undef;
88             }
89              
90             1;
91              
92             __END__