diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Data/Compare/Plugins/Scalar/Properties.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/Data/Compare/Plugins/Scalar/Properties.pm | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Data/Compare/Plugins/Scalar/Properties.pm b/Master/tlpkg/tlperl.straw/lib/Data/Compare/Plugins/Scalar/Properties.pm new file mode 100755 index 00000000000..0c46b6b9942 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Data/Compare/Plugins/Scalar/Properties.pm @@ -0,0 +1,94 @@ +package Data::Compare::Plugins::Scalar::Properties; + +use strict; +use vars qw($VERSION); +use Data::Compare; + +$VERSION = 1.0; + +sub register { + return [ + ['Scalar::Properties', \&sp_scalar_compare], + ['', 'Scalar::Properties', \&sp_scalar_compare], + ]; +} + +# note that when S::Ps are involved we can't use Data::Compare's default +# Compare function, so we use eq to check that values are the same. But +# we *do* use D::C::Compare whenever possible. + +# Compare a S::P and a scalar, or if we figure out that we've got two +# S::Ps, call sp_sp_compare instead + +sub sp_scalar_compare { + my($scalar, $sp) = @_; + + # we don't care what order the two params are, so swap if necessary + ($scalar, $sp) = ($sp, $scalar) if(ref($scalar)); + + # got two S::Ps? + return sp_sp_compare($scalar, $sp) if(ref($scalar)); + + # we've really got a scalar and an S::P, so just compare values + return 1 if($scalar eq $sp); + return 0; +} + +# Compare two S::Ps + +sub sp_sp_compare { + my($sp1, $sp2) = @_; + + # first check the values + return 0 unless($sp1 eq $sp2); + + # now check that we have all the same properties + return 0 unless(Data::Compare::Compare([sort $sp1->get_props()], [sort $sp2->get_props()])); + + # and that all properties have the same values + return 0 if( + grep { !Data::Compare::Compare(eval "\$sp1->$_()", eval "\$sp2->$_()") } $sp1->get_props() + ); + + # if we get here, all is tickety-boo + return 1; +} + +register(); + +=head1 NAME + +Data::Compare::Plugin::Scalar::Properties - plugin for Data::Compare to +handle Scalar::Properties objects. + +=head1 DESCRIPTION + +Enables Data::Compare to Do The Right Thing for Scalar::Properties +objects. + +=over 4 + +=item comparing a Scalar::Properties object and an ordinary scalar + +If you compare +a scalar and a Scalar::Properties, then they will be considered the same +if the two values are the same, regardless of the presence of properties. + +=item comparing two Scalar::Properties objects + +If you compare two Scalar::Properties objects, then they will only be +considered the same if the values and the properties match. + +=back + +=head1 AUTHOR + +Copyright (c) 2004 David Cantrell. All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Data::Compare> + +=cut |