File Coverage

blib/lib/Data/Compare/Plugins/Data/Transactional.pm
Criterion Covered Total %
statement 20 20 100.0
branch 1 2 50.0
condition 1 3 33.3
subroutine 8 8 100.0
pod n/a
total 30 33 90.9


line stmt bran cond sub pod time code
1             package Data::Compare::Plugins::Data::Transactional;
2              
3 2     2   43999 use strict;
  2         4  
  2         69  
4 2     2   9 use warnings;
  2         3  
  2         63  
5              
6 2     2   9 use Data::Compare;
  2         3  
  2         12  
7 2     2   9209 use Scalar::Util qw(blessed);
  2         4  
  2         450  
8              
9             our $VERSION = '1.04';
10              
11             sub _register {
12             return
13             [
14 2     2   25 ['Data::Transactional', \&_dt_dt_compare],
15             ['Data::Transactional', 'ARRAY', \&_dt_notdt_compare],
16             ['Data::Transactional', 'HASH', \&_dt_notdt_compare],
17             ];
18             }
19              
20             sub _dt_dt_compare {
21 21     21   1525 my($t1, $t2) = @_;
22 21         23 Compare(_underlying($t1), _underlying($t2));
23             }
24              
25             sub _dt_notdt_compare {
26 33     33   6242 my($dt, $notdt) = @_;
27 33 50 33     181 ($dt, $notdt) = ($notdt, $dt) if(!(blessed($dt) && $dt->isa('Data::Transactional')));
28 33         39 Compare(_underlying($dt), $notdt);
29             }
30              
31             sub _underlying {
32 75     75   56 my $tied = shift;
33 75         119 return $tied->current_state();
34             }
35              
36             _register();
37              
38             =head1 NAME
39              
40             Data::Compare::Plugin::Data::Transactional - plugin for Data::Compare to
41             handle Data::Transactional objects.
42              
43             =head1 DESCRIPTION
44              
45             Enables Data::Compare to Do The Right Thing for Data::Transactional
46             objects.
47              
48             =over
49              
50             =item comparing a Data::Transactional object to another Data::Transactional object
51              
52             If you compare two Data::Transactional objects, they compare equal if
53             their *current* values are the same. We never look at any checkpoints
54             that may be stored.
55              
56             =item comparing a Data::Transactional object to an ordinary array or hash
57              
58             These will be considered the same if they have the same current contents -
59             again, checkpoints are ignored.
60              
61             =back
62              
63             =head1 AUTHOR
64              
65             Copyright (c) 2004 David Cantrell. All rights reserved.
66             This program is free software; you can redistribute it and/or
67             modify it under the same terms as Perl itself.
68              
69             =head1 SEE ALSO
70              
71             L
72              
73             L
74              
75             =cut