Check::ISA - DWIM, correct checking of an object's class

Check-ISA documentation Contained in the Check-ISA distribution.

Index

Code Index:

NAME

Top

Check::ISA - DWIM, correct checking of an object's class

SYNOPSIS

Top

	use Check::ISA;

	if ( obj($foo, "SomeClass") ) {
		$foo->some_method;
	}




	# instead of one of these methods:
	UNIVERSAL::isa($foo, "SomeClass") # WRONG
	ref $obj eq "SomeClass"; # VERY WRONG
	$foo->isa("SomeClass") # May die
	local $@; eval { $foo->isa("SomeClass") } # too long

DESCRIPTION

Top

This module provides several functions to assist in testing whether a value is an object, and if so asking about its class.

FUNCTIONS

Top

obj $thing, [ $class ]

This function tests if $thing is an object.

If $class is provided, it also tests tests whether $thing->isa($class).

$thing is considered an object if it's blessed, or if it's a GLOB with a valid IO slot (the IO slot contains a FileHandle object which is the actual invocant). This corresponds directly to gv_fetchmethod.

obj_does $thing, [ $class_or_role ]

Just like obj but uses DOES in UNIVERSAL instead of isa in UNIVERSAL.

DOES in UNIVERSAL is just like isa, except it's use is encouraged to query about an interface, as opposed to the object structure. If DOES is not overridden by th ebject, calling it is semantically identical to calling isa.

This is probably reccomended over obj for interoperability, but can be slower on Perls before 5.10.

Note that DOES in UNIVERSAL

inv $thing, [ $class_or_role ]

Just like obj_does, but also returns true for classes.

Note that this method is slower, but is supposed to return true for any value you can call methods on (class, object, filehandle, etc).

Look into autobox if you would like to be able to call methods on all values.

obj_can $thing, $method
inv_can $thing, $method

Checks if $thing is an object or class, and calls can on $thing if appropriate.

SEE ALSO

Top

UNIVERSAL, Params::Util, autobox, Moose, asa

VERSION CONTROL

Top

This module is maintained using Darcs. You can get the latest version from http://nothingmuch.woobling.org/code, and use darcs send to commit changes.

AUTHOR

Top

Yuval Kogman <nothingmuch@woobling.org>

COPYRIGHT

Top

	Copyright (c) 2008 Yuval Kogman. All rights reserved
	This program is free software; you can redistribute
	it and/or modify it under the same terms as Perl itself.
Check-ISA documentation Contained in the Check-ISA distribution. 
#!/usr/bin/perl

package Check::ISA;

use strict;
use warnings;

use Scalar::Util qw(blessed);

use Sub::Exporter -setup => {
	exports => [qw(obj obj_does inv inv_does obj_can inv_can)],
	groups => {
		default => [qw(obj obj_does inv)],
	},
};

use constant CAN_HAS_DOES => not not UNIVERSAL->can("DOES");

use warnings::register;

our $VERSION = "0.04";

sub extract_io {
	my $glob = shift;

	# handle the case of a string like "STDIN"
	# STDIN->print is actually:
	#   const(PV "STDIN") sM/BARE
	#   method_named(PV "print")
	# so we need to lookup the glob
	if ( defined($glob) and !ref($glob) and length($glob) ) {
		no strict 'refs';
		$glob = \*{$glob};
	}

	# extract the IO
	if ( ref($glob) eq 'GLOB' ) {
		if ( defined ( my $io = *{$glob}{IO} ) ) {
			require IO::Handle;
			return $io;
		}
	}

	return;
}

sub obj ($;$); # predeclare, it's recursive

sub obj ($;$) {
	my ( $object_or_filehandle, $class ) = @_;

	my $object = blessed($object_or_filehandle)
		? $object_or_filehandle
		: extract_io($object_or_filehandle) || return;

	if ( defined $class ) {
		$object->isa($class)
	} else {
		return 1; # return $object? what if it's overloaded?
	}
}

sub obj_does ($;$) {
	my ( $object_or_filehandle, $class_or_role ) = @_;

	my $object = blessed($object_or_filehandle)
		? $object_or_filehandle
		: extract_io($object_or_filehandle) || return;

	if ( defined $class_or_role ) {
		if ( CAN_HAS_DOES ) {
			# we can be faster in 5.10
			$object->DOES($class_or_role);
		} else {
			my $method = $object->can("DOES") || "isa";
			$object->$method($class_or_role);
		}
	} else {
		return 1; # return $object? what if it's overloaded?
	}
}

sub inv ($;$) {
	my ( $inv, $class_or_role ) = @_;

	if ( blessed($inv) ) {
		return obj_does($inv, $class_or_role);
	} else {
		# we check just for scalar keys on the stash because:
		# sub Foo::Bar::gorch {}
		# Foo->can("isa") # true
		# Bar->can("isa") # false
		# this means that 'Foo' is a valid invocant, but Bar is not

		if ( !ref($inv)
				and
			defined $inv
				and
			length($inv)
				and
			do { no strict 'refs'; scalar keys %{$inv . "::"} }
		) {
			# it's considered a class name as far as gv_fetchmethod is concerned
			# even if the class def is empty
			if ( defined $class_or_role ) {
				if ( CAN_HAS_DOES ) {
					# we can be faster in 5.10
					$inv->DOES($class_or_role);
				} else {
					my $method = $inv->can("DOES") || "isa";
					$inv->$method($class_or_role);
				}
			} else {
				return 1; # $inv is always true, so not a problem, but that would be inconsistent
			}
		} else {
			return;
		}
	}
}

sub obj_can ($;$) {
	my ( $obj, $method ) = @_;
	(blessed($obj) ? $obj : extract_io($obj) || return)->can($method);
}

sub inv_can ($;$) {
	my ( $inv, $method ) = @_;
	obj_can($inv, $method) || inv($inv) && $inv->can($method);
}


__PACKAGE__

__END__