Class::Comparable - A base class for comparable objects

Class-Comparable documentation Contained in the Class-Comparable distribution.

Index

Code Index:

NAME

Top

Class::Comparable - A base class for comparable objects

SYNOPSIS

Top

  # an example subclass 

  package Currency::USD;

  use base 'Class::Comparable';

  sub new { 
    my $class = shift;
    bless { value => shift }, $class;
  }

  sub value { (shift)->{value} }

  sub compare {
    my ($left, $right) = @_;
    # if we are comparing against another
    # currency object, then compare values
    if (ref($right) && $right->isa('Currency::USD')) {
        return $left->value <=> $right->value;
    }
    # otherwise assume we are comparing 
    # against a numeric value of some kind
    else {
        return $left->value <=> $right;
    }
  }

  # an example usage of Class::Comparable object

  my $buck_fifty = Currency::USD->new(1.50);
  my $dollar_n_half = Currenty::USD->new(1.50);

  ($buck_fifty == $dollar_n_half) # these are equal
  (1.75 > $buck_fifty) # 1.75 is more than a buck fifty      

  my $two_bits = Currency::USD->new(0.25);

  ($two_bits < $dollar_n_half) # 2 bits is less than a dollar and a half
  ($two_bits == 0.25) # two bits is equal to 25 cents

DESCRIPTION

Top

This module provides two things. First, it provides a base set of methods and overloaded operators for implementing objects which can be compared for equality (== & !=) and magnitude (<, <=, <=>, => & >). Second, it serves as a marker interface for objects which can be compared much like Java's Comparable interface.

METHODS

Top

compare ($compare_to)

This method is abstract, and will throw an exception unless it is properly overridden by the class which implements Class::Comparable. This method is expected to return 1 if the invocant is greater than $compare_to, 0 if they are equal to one another and -1 if the invocant is less than $compare_to.

NOTE: This method used to have a second argument ($is_reversed) which handled the odd cases where comparison arguments are reversed. This is now handled automatically, so you can simply compare your objects values in the order they are passed to compare, and this class will handle the details.

equals ($compare_to)

Returns true (1) if the invocant is equal to the $compare_to argument (as determined by compare) and return false (0) otherwise.

notEquals ($compare_to)

Returns true (1) if the invocant is not equal to the $compare_to argument (as determined by equals) and return false (0) otherwise.

isBetween ($left, $right)

Returns true (1) if the invocant is greater than or equal to $left and less than or equal to $right (as determined by compare) and return false (0) otherwise. This method does not enforce the fact that $left should be less than $right so that it can allow for compare to accept non-standard values.

isExactly ($compare_to)

Returns true (1) if the invocant is exactly the same instance as $compare_to and return false (0) otherwise. This method will correctly handle objects who overload the "" (stringification) operator.

OPERATORS

Top

==

This operator is implemented by the equals method.

!=

This operator is implemented by the notEquals method.

<=>

This operator is implemented by the compare method. It should be noted that perl will auto-generate the means to handle the <, <=, >= and > operators as well (see the overload docs for more information about auto-generation).

IMPORTANT NOTE

Top

The compare method now works correctly (and automatically) even if the values being compared are reversed. This usually only happens when an object is compared to another non-object (or another object which doesn't overload the <=> operator). For instance, if the object is the left operand, like this:

  ($obj < 5) # the $obj is less than 5

then the arguments to the compare routine will be in the correct order. However if the object is the right operand, like this:

  (5 > $obj) # 5 is greater than $obj

then the arguments to the compare routine will be in the wrong order, meaning that our first argument is our right operand, and our second argument is our left operand. We take care of the details of reversing the output to make sure that the comparison returns the correct value.

BUGS

Top

None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it.

CODE COVERAGE

Top

I use Devel::Cover to test the code coverage of my tests, below is the Devel::Cover report on this module test suite.

 ------------------------ ------ ------ ------ ------ ------ ------ ------
 File                       stmt branch   cond    sub    pod   time  total
 ------------------------ ------ ------ ------ ------ ------ ------ ------
 Class/Comparable.pm       100.0  100.0  100.0  100.0  100.0  100.0  100.0
 ------------------------ ------ ------ ------ ------ ------ ------ ------
 Total                     100.0  100.0  100.0  100.0  100.0  100.0  100.0
 ------------------------ ------ ------ ------ ------ ------ ------ ------

SEE ALSO

Top

There are a number of comparison modules out there (http://search.cpan.org/search?query=Compare&mode=all), many of which can be used in conjunction with this module to help implement the compare method for your class.

AUTHOR

Top

stevan little, <stevan@iinteractive.com>

COPYRIGHT AND LICENSE

Top

Copyright 2004 by Infinity Interactive, Inc.

http://www.iinteractive.com

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Class-Comparable documentation Contained in the Class-Comparable distribution. 
package Class::Comparable;

use strict;
use warnings;

our $VERSION = '0.02';

# NOTE:
# magnitude (<, <=, >=, >) is not the same as equality (==, !=)
# there may come a time when it makes sense to implement 
# object equality seperately from object magnitude, so we 
# define equals and notEquals methods and operators seperately,
# which will by default "do the right thing", but allow the 
# flexibility which may be needed down the road

use overload (
    '=='     => "equals",
    '!='     => "notEquals",
    '<=>'    => "_compare",
    fallback => 1
    );

# we do not supply a default here since very rarely 
# would a default be appropriate. So unless
# this is overridden, an exception is thrown.
sub compare { die "Method Not Implemented : no comparison method specified" }

sub _compare {
	my ($left, $right, $reversed) = @_;
    my $r = $left->compare($right);
    # if we are not reversed, then we 
    # can return the unaltered result
    return $r if not $reversed;
    # however, if we *are* reversed, and
    # the result is 0, we can return the
    # unaltered 0 as well. 
    return $r if $r == 0;
    # now if we *are* reveresed, and we
    # are not zero, then we need to negate 
    # our value, which essentially reverses
    # it so 1 becomes -1 and -1 becomes 1 
    return -$r;
}

# equals is implemented in terms of compare
sub equals {
	my ($left, $right) = @_;
	return ($left->compare($right) == 0);
}

# notEquals is implemented in terms of equals
sub notEquals {
	my ($left, $right) = @_;
	return !$left->equals($right);
}

# isBetween is implemented in terms of compare
sub isBetween {
	my ($self, $left, $right) = @_;
    # greater than or equal to the left value
    # and less than or equal to the right value
    return (($self->compare($left) >= 0) && ($self->compare($right) <= 0));    
}

# this method attempts to decide if an object
# is exactly the same as one another. It does
# this by comparing the Perl built-in string 
# representations of a reference and displays
# the object's memory address. 
sub isExactly {
	my ($left, $right) = @_;
    # if nothing is passed, then it cannot be 
    # the same thing, we choose to return false
    # here rather than die so it works when a
    # null pointer is passed.
	return 0 unless defined($right);
	# we check to see if we are dealing with the same 
	# types objects by calling ref, which will return
	# the top level class of the object. If they do 
	# not share that in common, they are certainly not
	# the same object.
	return 0 unless ref($left) eq ref($right);
	# from now on this gets a little trickier...
	# First we need to test if the objects overloads
	# the stringification operator, in which case
	# we need to extract the string value. We can get
	# away with just checking the overloading on the
	# left argument, since our test above has already
	# told us they are the same class.
	return (overload::StrVal($left) eq overload::StrVal($right)) if overload::Method($left, '""');
	# if the object does not overload the stringification 
	# operator, then that means that we can use the built 
	# in Perl stringification routine then. If these strings 
	# match then the memory address will match as well, and 
	# we will know we have the exact same object.
	return ("$left" eq "$right");
}

1;

__END__