File Coverage

blib/lib/Class/Trait/Lib/TComparable.pm
Criterion Covered Total %
statement 14 14 100.0
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 21 95.2


line stmt bran cond sub pod time code
1             package TComparable;
2              
3 3     3   14 use strict;
  3         6  
  3         98  
4 3     3   12 use warnings;
  3         7  
  3         117  
5              
6             our $VERSION = '0.31';
7              
8             ## we are a trait
9 3     3   13 use Class::Trait 'base';
  3         6  
  3         22  
10              
11 3     3   14 use Class::Trait qw(TEquality);
  3         11  
  3         12  
12              
13             ## overload operator
14              
15             our %OVERLOADS = ( '<=>' => "compare" );
16              
17             ## requires methods
18              
19             our @REQUIRES = qw(compare);
20              
21             ### methods
22              
23             # The equals method is there to provide
24             # specific handler for the '==' operator (and
25             # to be sure about how '!=' will react, we
26             # override the autogeneration with the _notEquals
27             # method).
28             # This is here so that one can deal with '==' and '!='
29             # and not the '<', '<=', '<=>', '=>', '>' operators.
30             # NOTE:
31             # Our default implementation of equals actually defers
32             # to the compare method, and the _notEquals method
33             # actually defers to the value of equals (and returns
34             # the inverse), so that an object which wants all
35             # the operators ('<=>' and co.) will be able to use
36             # the '==' and '!=' operators without an issue.
37             # If however compare is not defined, a
38             # MethodNotImplemented exception will be thrown.
39             # This retains backwards compatability while still
40             # allowing for specialization.
41             sub equalTo {
42 4     4   11 my ( $left, $right ) = @_;
43 4 50       18 return ( $left->compare($right) == 0 ) ? 1 : 0;
44             }
45              
46             1;
47              
48             __END__