#!/usr/bin/perl
#use Mooix::Thing;

# Disable debugging for the duration of this method to prevent any
# deep recursion.
delete $ENV{MOOIX_DEBUG};

sub formatobj {
	my $obj=shift;
	my $format=shift;
	
	$format=~s/\$(name|id)/$1 eq "name" ? $obj->name : $obj/eg;
	return $format;
}

sub sendmessage {
	my $this=shift;
	my $message=shift;
	my $session=$this->session;
	if (ref $session) {
		# Make sure the session is listed as one of the owner's.
		# It's possible they've logged out of the session,
		# and a new one has its same id, but it used by someone
		# else.
		if (! grep { $_ == $session } $this->owner->sessions->list) {
			unlink("session"); # may fail
			print STDERR "$message\n";
		}
		else {
			$session->write($message);
		}
	}
	else {
		print STDERR "$message\n";
	}
}

run sub {
	my $this=shift;
	%_=@_;
	
	if (! ref $_{object}) {
		$this->croak("called without object");
	}
	if (! length $_{method}) {
		$this->croak("called without method");
	}
	if (! length $_{type}) {
		$this->croak("called without type");
	}
	
	my @ret;
	if ($_{replace}) {
		# Put the values in @ret. There may be multiple values.
		for (my $x=0; $x < @_; $x=$x+2) {
			if ($_[$x] eq 'value') {
				push @ret, $_[$x+1];
			}
		}
	}
	
	my $done=0;
	foreach my $exp ($this->expressions) {
		($action, $object, $method, $type, $field) = split(' ', $exp, 5);
		if (($object eq '*' || $this->get($object) == $_{object}) &&
		    ($method eq '*' || $method eq $_{method})) {
			# Work out the return value, which is always the
			# list of all non-skip expressions that apply to
			# the calling object's method. Shorten the
			# expressions to /only include the type and field.
			if (! $_{replace} && $action ne 'skip') {
				$exp=~s/^\w+ [^ ]+ [^ ]+ //;
				push @ret, $exp;
			}
		    
			# Only act on the expression if this is the first
			# match.
			next if $done;
			if (($type eq '*' || $type eq $_{type}) &&
			    ($field eq '*' || $field eq $_{field})) {
				$done = 1;
				
				if ($action eq 'skip') {
				}
				elsif ($action eq 'trace' || $action eq 'breakpoint') {
					my $objformat=$this->traceformat;
					
					my $message="";
					if ($this->timestamped) {
						$message.="[".scalar(localtime)."] ";
					}
					$message.=formatobj($_{object}, $objformat)."->$_{method}: $_{type} ";
					if (ref $_{accessee} && $_{accessee} != $_{object}) {
						$message.=formatobj($_{accessee}, $objformat)."->";
					}
					if (length $_{field}) {
						$message.=$_{field};
					}
					if ($_{type} eq "call") {
						$message.="(";
					}
					elsif ($_{type} eq 'write') {
						$message.=" = ";
					}
					elsif (length $_{field}) {
						$message.=" ";
					}
					my @messages;
					for (my $x=0; $x < @_; $x=$x+2) {
						if ($_[$x] eq 'message') {
							if (ref $_[$x+1]) {
								push @messages, formatobj($_[$x+1], $objformat);
							}
							elsif ($value=~/^[A-Za-z0-9_]+$/) {
								push @messages, $_[$x+1];
							}
							else {
								push @messages, qq{"$_[$x+1]"};
							}
						}
					}
					$message.=join(", ", @messages);
					if ($_{type} eq "call") {
						$message.=")";
					}
		
					if ($action eq 'breakpoint') {
						# set return field to
						# current return value so
						# user can replace it while
						# we're stopped
						if ($_{replace}) {
							$this->return(@ret ? @ret : "");
							sendmessage($this, "(breakpoint with return) $message");
						}
						else {
							sendmessage($this, "(breakpoint) $message");
						}
						kill "STOP", 0;
						if ($_{replace}) {
							@ret=$this->return;
							$this->return(''); # clear
						}
						sendmessage($this, "(continuing) $message");
					}
					else {
						sendmessage($this, $message);
					}
				}
				else {
					$this->croak("bad action type, \"$action\", in expressions");
				}
			}
		}
	}
	
	return @ret;
}
