File Coverage

blib/lib/Data/Compare/Plugins/Scalar/Properties.pm
Criterion Covered Total %
statement 13 24 54.1
branch 0 12 0.0
condition n/a
subroutine 5 7 71.4
pod 0 3 0.0
total 18 46 39.1


line stmt bran cond sub pod time code
1             package Data::Compare::Plugins::Scalar::Properties;
2              
3 14     14   94 use warnings;
  14         29  
  14         515  
4 14     14   67 use strict;
  14         26  
  14         301  
5 14     14   71 use vars qw($VERSION);
  14         26  
  14         568  
6 14     14   84 use Data::Compare;
  14         33  
  14         1647  
7              
8             $VERSION = 1.25;
9              
10             sub register {
11             return [
12 14     14 0 193 ['Scalar::Properties', \&sp_scalar_compare],
13             ['', 'Scalar::Properties', \&sp_scalar_compare],
14             ];
15             }
16              
17             # note that when S::Ps are involved we can't use Data::Compare's default
18             # Compare function, so we use eq to check that values are the same. But
19             # we *do* use D::C::Compare whenever possible.
20              
21             # Compare a S::P and a scalar, or if we figure out that we've got two
22             # S::Ps, call sp_sp_compare instead
23              
24             sub sp_scalar_compare {
25 0     0 0   my($scalar, $sp) = @_;
26              
27             # we don't care what order the two params are, so swap if necessary
28 0 0         ($scalar, $sp) = ($sp, $scalar) if(ref($scalar));
29              
30             # got two S::Ps?
31 0 0         return sp_sp_compare($scalar, $sp) if(ref($scalar));
32              
33             # we've really got a scalar and an S::P, so just compare values
34 0 0         return 1 if($scalar eq $sp);
35 0           return 0;
36             }
37              
38             # Compare two S::Ps
39              
40             sub sp_sp_compare {
41 0     0 0   my($sp1, $sp2) = @_;
42              
43             # first check the values
44 0 0         return 0 unless($sp1 eq $sp2);
45            
46             # now check that we have all the same properties
47 0 0         return 0 unless(Data::Compare::Compare([sort $sp1->get_props()], [sort $sp2->get_props()]));
48              
49             # and that all properties have the same values
50             return 0 if(
51 0 0         grep { !Data::Compare::Compare(eval "\$sp1->$_()", eval "\$sp2->$_()") } $sp1->get_props()
  0            
52             );
53              
54             # if we get here, all is tickety-boo
55 0           return 1;
56             }
57              
58             register();
59              
60             =head1 NAME
61              
62             Data::Compare::Plugin::Scalar::Properties - plugin for Data::Compare to
63             handle Scalar::Properties objects.
64              
65             =head1 DESCRIPTION
66              
67             Enables Data::Compare to Do The Right Thing for Scalar::Properties
68             objects.
69              
70             =over 4
71              
72             =item comparing a Scalar::Properties object and an ordinary scalar
73              
74             If you compare
75             a scalar and a Scalar::Properties, then they will be considered the same
76             if the two values are the same, regardless of the presence of properties.
77              
78             =item comparing two Scalar::Properties objects
79              
80             If you compare two Scalar::Properties objects, then they will only be
81             considered the same if the values and the properties match.
82              
83             =back
84              
85             =head1 AUTHOR
86              
87             Copyright (c) 2004 David Cantrell. All rights reserved.
88             This program is free software; you can redistribute it and/or
89             modify it under the same terms as Perl itself.
90              
91             =head1 SEE ALSO
92              
93             L
94              
95             =cut