File Coverage

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


line stmt bran cond sub pod time code
1             package Data::Compare::Plugins::Data::Transactional;
2              
3 2     2   57156 use strict;
  2         6  
  2         83  
4 2     2   10 use warnings;
  2         4  
  2         63  
5              
6 2     2   9 use Data::Compare;
  2         4  
  2         16  
7 2     2   12789 use UNIVERSAL;
  2         19  
  2         9  
8              
9             our $VERSION = '1.03';
10              
11             sub _register {
12             return
13             [
14 2     2   27 ['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   2661 my($t1, $t2) = @_;
22 21         38 Compare(_underlying($t1), _underlying($t2));
23             }
24              
25             sub _dt_notdt_compare {
26 33     33   6941 my($dt, $notdt) = @_;
27 33 50       109 ($dt, $notdt) = ($notdt, $dt) if(!UNIVERSAL::isa($dt, 'Data::Transactional'));
28 33         62 Compare(_underlying($dt), $notdt);
29             }
30              
31             sub _underlying {
32 75     75   95 my $tied = shift;
33 75         215 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