use strict;

sub method ($$) {
	my ($name, $code) = @_;
	my ($package, $filename, $line) = caller;

	print "$package::$name\n";
	
	*{"${package}::$name"} = eval qq{
		sub {
			die "attempt to call method ${package}::$name as a subroutine\n" unless defined \$_[0] and ref \$_[0]; # check more?
			print STDERR "entering method ${package}::$name of \$_[0]\\n";
			$code
			print STDERR "leaving method ${package}::$name of \$_[0]\\n";
		}
	};
}

package DB;

sub fail {
	local $| = 1;

	use Data::Dumper;
	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Indent = 0;
	
	@DB::args = ();

	# this loop should not be needed anymore, only with eval, didn't work
	# anyway
	my $n = 0;
	my ($package, $filename, $line, $sub, $object, @args);
	do {
		($package, $filename, $line) = caller($n++);
		$sub = (caller($n))[3];
#		print "$n>>>>$filename $sub\n";
	} while $filename =~ /^\(eval / or $sub =~ /^DB::fail$/;
	($object, @args) = @DB::args;

#	print ">>>>$n\n";

	my $printable_args = Dumper \@args;
	$printable_args = substr $printable_args, 1, -1; # lose [, ]
		
	print STDERR "\nfailed, $filename line $line\n";
	print STDERR "\nmethod call was ${object}->$sub($printable_args)\n";
		
	my $method_code = get_method($filename, $line);
	print STDERR "\n$method_code\n";
	print STDERR "do you want to repair the code (y/n) ? ";
	if (<> eq "y\n") {
		system "vim +$line $filename";
		do $filename;
#		my $new_method_code = get_method($filename, $line); # this is dodgy!
#		eval qq{
#			package $package;
#			$new_method_code
#		};
		print STDERR "\n\ndo you want to resend the message (y/n) ? ";
		if (<> eq "y\n") {
			print STDERR "sending $object->$sub(@args)\n\n";
			return $object->$sub(@args);
		}
	}

	return;
}

use IO::File;

# precondition - code is well indented!!

sub get_method {
	my ($filename, $line_number) = @_;
	my $fh;
	unless ($fh = IO::File->new($filename, "r")) {
		warn "cannot open file `$filename'\n";
		return;
	}
	my $code;
	my $line;
	for my $n (1..$line_number) {
		$line = <$fh>;
#		print "1>>> $line\n";
		if ($line =~ /^sub /) { $code = $line; }
		else { $code .= $line; }
	}
	while ($line !~ /^}/) {
		$line = <$fh>;
#		print "2>>> $line\n";
		$code .= $line;
	}

	return $code;
}

1