File Coverage

blib/lib/ObjectivePerl/Runtime.pm

Criterion	Covered	Total	%
statement	6	68	8.8
branch	0	32	0.0
condition	0	8	0.0
subroutine	2	11	18.1
pod	0	9	0.0
total	8	128	6.2

# ==========================================
# Copyright (C) 2004 kyle dawkins
# kyle-at-centralparksoftware.com
# ObjectivePerl is free software; you can
# redistribute and/or modify it under the
# same terms as perl itself.
# ==========================================

package ObjectivePerl::Runtime;
use strict;
use Data::Dumper;

my $_runtime; # we will use a singleton runtime to track classes etc.

sub runtime {
	my $className = shift;
	unless ($_runtime) {
		$_runtime = bless {}, $className;
		$_runtime->init();
	}
	return $_runtime;
}

sub init {
	my $self = shift;
}

sub debug {
	my $self = shift;
	return $self->{_debug};
}

sub setDebug {
	my $self = shift;
	$self->{_debug} = shift;
}

sub camelBonesCompatibility {
	my $self = shift;
	return $self->{_camelBonesCompatibility};
}

sub setCamelBonesCompatibility {
	my $self = shift;
	$self->{_camelBonesCompatibility} = shift;
}

sub ObjpMsgSend {
	my $className = shift;
	# For some reason, CamelBones yacks if you don't assign the return
	# value to a variable at some point (maybe can't fish things off the stack?)
	# so we would have to do this even without the debug line
	my $returnValue = $className->runtime()->objp_msgSend(@_);
	if ($className->runtime()->debug() & $ObjectivePerl::DEBUG_MESSAGING) {
		print "Return value: ".Data::Dumper->Dump([$returnValue], [qw($value)])."\n";
	}
	return $returnValue;
}

sub objp_msgSend {
	my $self = shift;
	my $receiver = shift || "";
	my $message = shift || "";
	my $selectors = shift || []; # an array of key value pairs

	if ($self->debug() & $ObjectivePerl::DEBUG_MESSAGING) { print "Trying to invoke $message on $receiver\n" };
	return undef unless $receiver;
	return undef unless $message;
	# the first argument is the entry for $message
	my $messageSignature = messageSignatureFromMessageAndSelectors($message, $selectors) || "";

	my $argumentList = [];
	foreach my $selector (@$selectors) {
		push (@$argumentList, $selector->{value});
	}

	# send the message
	if (UNIVERSAL::can($receiver, $messageSignature)) {
		if ($self->debug() & $ObjectivePerl::DEBUG_MESSAGING) { print "Invoking $messageSignature on object $receiver\n"; }
		return $receiver->$messageSignature(@$argumentList);
	} else {
		my $messageSignatureWithNoUnderscores = lcfirst(join("", map {ucfirst($_)} split(/_/, $messageSignature)));
		if (UNIVERSAL::can($receiver, $messageSignatureWithNoUnderscores)) {
			if ($self->debug() & $ObjectivePerl::DEBUG_MESSAGING) { print "Invoking $messageSignatureWithNoUnderscores on object $receiver\n"; }
			return $receiver->$messageSignatureWithNoUnderscores(@$argumentList);
		}
		my $messageSignatureWithTrailingUnderscores = $messageSignatureWithNoUnderscores.("_" x scalar(@$argumentList));
		if (UNIVERSAL::can($receiver, $messageSignatureWithTrailingUnderscores)) {
			if ($self->debug() & $ObjectivePerl::DEBUG_MESSAGING) { print "Invoking $messageSignatureWithTrailingUnderscores on object $receiver\n"; }
			return $receiver->$messageSignatureWithTrailingUnderscores(@$argumentList);
		}
	}
	# TODO: Handle unknown static methods... this will only work with instance methods
	if (UNIVERSAL::can($receiver, "handleUnknownSelector")) {
		if ($self->debug() & $ObjectivePerl::DEBUG_MESSAGING) { print "Invoking handleUnknownSelector on object $receiver\n"; }
		return $receiver->handleUnknownSelector($message, $selectors);
	} else {
		# can't find the method anywhere, so just send it to the object and see what happens
		return $receiver->$messageSignature(@$argumentList);
	}
	return undef;
}

sub messageSignatureFromMessageAndSelectors {
	my $message = shift;
	my $arguments = shift;
	my $messageSignature = $message;
	if ($arguments) {
		foreach my $argument (@$arguments) {
			next if ($argument->{key} eq $message);
			if ($argument->{key} eq "_") {
				$messageSignature .= "_";
			} else {
				$messageSignature .= "_".$argument->{key};
			}
		}
	}
	return $messageSignature;
}

1;