Class::Implements - pretend that your class is another class

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

Index

Code Index:

NAME

Top

Class::Implements - pretend that your class is another class

SYNOPSIS

Top

  package Some::Class;
  use Class::Implements 'Some::Other::Class';

  print "You are the droids I'm looking for\n"
   if UNIVERSAL::isa( "Some::Class", "Some::Other::Class" );

DESCRIPTION

Top

Some module authors will insist on writing their object type checks as:

 die "go away"
   unless UNIVERSAL::ISA( $object, "The::Class:I'm::Willing::To::Deal::With" );

It it this authors opinion that this is wrong, and the guilty developers should be sent to their room without their supper until they realise that they should be writing:

 die "go away"
   unless $object->isa( "The::Class:I'm::Willing::To::Deal::With" );

So that other module authors can provide an isa method if they decide to.

Of course, while they're busy contemplating what they've done wrong their existing code isn't going to be changed, so you'll have to use this module. It brings some relief by supplying a fake UNIVERSAL::isa which understands how to stretch the truth a little.

AUTHOR

Top

Richard Clamp <richardc@unixbeard.net>

Copyright 2004 Richard Clamp. All Rights Reserved.

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

BUGS

Top

None known.

Bugs should be reported to me via the CPAN RT system. http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class::Implements.

SEE ALSO

Top

Hook::Queue

Class-Implements documentation Contained in the Class-Implements distribution. 
package Class::Implements;
use strict;
use warnings;
our $VERSION = 0.01;

my %liars;

use Hook::Queue 'UNIVERSAL::isa' => sub {
    my $ref = shift;
    my $what = shift;
    return 1 if grep { $_ eq $what } @{ $liars{ ref $ref || $ref } || [] };
    return Hook::Queue->defer();
};

sub import {
    my $self = shift;
    my $what = shift;
    my $liar = caller;
    push @{ $liars{ $liar } }, $what;
}

1;

__END__