File: TEquality.pm

package info (click to toggle)
libclass-trait-perl 0.31-1
  • links: PTS
  • area: main
  • in suites: squeeze, wheezy
  • size: 364 kB
  • ctags: 156
  • sloc: perl: 2,467; makefile: 46
file content (133 lines) | stat: -rw-r--r-- 3,378 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
package TEquality;

use strict;
use warnings;

our $VERSION = '0.31';

use Class::Trait 'base';

our %OVERLOADS = (
    '==' => "equalTo",
    '!=' => "notEqualTo"
);

our @REQUIRES = ("equalTo");

sub notEqualTo {
    my ( $left, $right ) = @_;
    return not $left->equalTo($right);
}

sub isSameTypeAs {
    my ( $left, $right ) = @_;

    # we know the left operand is an object right operand must be an object
    # and either right is derived from the same type as left or left is
    # derived from the same type as right

    return ( ref($right)
          && ( $right->isa( ref($left) ) || $left->isa( ref($right) ) ) );
}

# 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 ( $self, $candidate ) = @_;

    # $candidate must also be a Comparable object, otherwise there is no way
    # they can be the same.  Along the same veins, we can check very quickly
    # to see if we are dealing with the same objects by testing the values
    # returned by ref(), for if they are not the same, then again, this fails.

    return 0 unless ref($self) eq ref($candidate);

    # from now on this gets a little trickier...  First we need to test if the
    # objects are Printable, since this will prevent us from being able to get
    # a proper string representation of the object's memory address through
    # normal stringification, and so we will need to call its method
    # stringValue (see the Printable interface for more info)

    return ( $self->stringValue() eq $candidate->stringValue() )
      if $self->does("TPrintable");

    # if the object is not Printable, that means that we can use the built in
    # Perl stringification routine then, so we do just that, if these strings
    # match then the memory address will match as well, and we will know we
    # have the exact same object.

    return ( "$self" eq "$candidate" );
}

1;

__END__

=head1 NAME 

TEquality - Trait for adding equality testing to your object

=head1 DESCRIPTION

TEquality adds a number of equality testing features, including type-equality
as well as object instance equality. 

=head1 REQUIRES

=over 4

=item B<equalTo ($left, $right)>

The C<equalTo> method is expected to return either true if its two arguments
are equal (by whatever standards your devise), or false if they are not. 

=back

=head1 OVERLOADS

=over 4

=item B<==>

=item B<!=>

=back

=head1 PROVIDES

=over 4

=item B<notEqualTo ($left, $right)>

This is the inverse of C<equalTo>.

=item B<isSameTypeAs ($left, $right)>

This will determine type equality, meaning it will determine if both
arguements are derived from the same type.

=item B<isExactly ($left, $right)>

This will attempt to discern whether or not the two arguments given are the
same object. It even takes into account the possibility that the objects might
also have utilized the TPrintable trait, and so works around that automatic
stringification.

=back

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2004, 2005 by Infinity Interactive, Inc.

L<http://www.iinteractive.com> 

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

=cut