sub DOES { qw/log print/, shift->SUPER::DOES() }</code). Realy just for my fun and amusment. ;)  /me goes off to investigate the various roles modules</p>
<code>
use strict;
use warnings;

use Test::More qw/no_plan/;

{ package UNIVERSAL;
  sub does {
	return 1 if ref $_[0] eq $_[1];
	#if ( eval qq/"@" . ref($_[0]) . "::DOES"/;
	if (UNIVERSAL::isa($_[0], 'UNIVERSAL') ) {
	  if ($_[0]->can('DOES')) { 
	    return 1 if grep { $_[1] eq $_ } $_[0]->DOES();
	  } else {
		return 1 if $_[0]->isa($_[1]);	   
	  }
    }
	return 0;
  }
}

sub say {print @_, "\n";}
	
{package Foo};

is(UNIVERSAL::does(sub{},'CODE'),  1, 'Code Ref');          
is(UNIVERSAL::does(qr//,'Regexp'), 1, 'Regex');            # return true
is(UNIVERSAL::does([],'ARRAY')   , 1, 'Array')  ;             # return true
is(UNIVERSAL::does([],'The::Funky::Chicken'),0 , 'Bad Class name') ;# return false
is(UNIVERSAL::does([],'UNIVERSAL'),0, 'Array isn\'t Univeral')  ;        # return false

@Bar::ISA=qw(Foo);
is(UNIVERSAL::does('Bar', 'Foo'), 1, 'Bar does Foo');          # return true

{package Bang;
   @Bang::ISA=qw(Foo UNIVERSAL);
   sub DOES { qw(test) };
}
is(Bang->does('Foo'), 0, 'Bang doesn\'t Foo');          			   # return false


{ package A;
  sub DOES { qw/this or that/ };
}

{ package B;
  @B::ISA = qw/A/;
  sub DOES { qw/other/ };  
}

#B->test();
is(A->does('this') , 1, 'A does this');   # true
is(B->does('that') , 0, 'B doesn\'t do that');    # false
is(B->does('other'), 1, 'B does other');   # true