require 5.005_62; use strict; use warnings;

our $VERSION = '0.02';

{
	package Obsessor::Event;

	Class::Maker::class
	{
		public =>
		{
			string => [qw( object method )],

			array => [qw( arguments )],
		},
	};

	sub to_text : method
	{
		my $this = shift;

			printf $Class::Maker::TRACE "visiting %s->%s\n", ref( $this->object ) || $this->object, $this->method;
	}
}

package Obsessor;

Class::Maker::class
{
	public =>
	{
		array => [qw( bouncers )],
	},

	private =>
	{
		ref => { target => 'UNIVERSAL', event => 'Obsessor::Event' },
	},
};

use vars qw($AUTOLOAD);

sub _preinit
{
	my $this = shift;

		$this->_target( undef );

		$this->_event( Obsessor::Event->new() )
}

sub _postinit
{
	my $this = shift;

		$this->target( $this->_target ) if $this->_target;
}

sub target : method
{
	my $this = shift;

	my $destination = shift or die 'new() needs a blessed object or classname as first argument';

			# Binding to class or object...

		$this->_target( ref($destination) ? $destination : $destination->new( @_ ) );

		$this->_event->object( $this->_target );

		printf $Class::Maker::TRACE "\ntaking over '%s'\n", $this->_target;

return $this->_target;
}

	# Future: Class::Maker::Examples::Obsessor should more obscure himself
	#
	#	"goto &func" would be the best solution.
	#
	#	#my $fullfunc = \&{ "${destpack}::$func" };
	#	#goto &$fullfunc if $target->can( $func ) or die "unhandled method $target->$func via Obsessor";

sub AUTOLOAD : method
{
	my $this = shift || return undef;

	my @args = @_;

		my $func = $AUTOLOAD;

		$func =~ s/.*:://;

		return if $func eq 'DESTROY';

		no strict 'refs';

		@_ = ( $this->_target, @args );

		#die "unhandled method $target->$func" unless $target->can( $func );

		$this->_event->arguments( [ @_ ] );

		$this->_event->method( $func );

		foreach my $bouncer ( @{ $this->bouncers } )
		{
			unless( $bouncer->inspect( $this->_event ) )
			{
				die sprintf( "Bouncer $bouncer intercepted at $this->_event for '%s'", $this->_event->method );
			}
		}

		$this->_event->to_text();

return wantarray ? @{ [ $this->_target->$func( @_ ) ] } : $this->_target->$func( @_ );
}

1;

__END__

=head1 NAME

Obsessor - methodcall dispatcher/forwarder

=head1 SYNOPSIS

  use Class::Maker::Examples::Obsessor;

  use Verify;

  use Class::Maker::Examples::User;

		# binding to a class (a clean object is created)
	{
		my $user = Obsessor->new( target => 'User' );

		$user->email( 'murat.uenalan@gmx.de' );

		$user->firstname( 'Murat' );

		$user->lastname( 'Murat' );

		#$user->blabla();

		print Dumper $user;
	}

		# binding to existing object
	{
		my $user = Obsessor->new( target => new User( firstname => 'Murat', lastname => 'Uenalan' ) );

		$user->email( 'murat.uenalan@gmx.de' );

		$user->firstname( 'Murat' );

		#$user->blabla();

		print Dumper $user;
	}

package Verify::Type;

		our $positivliste = new Verify::Type(

			desc => 'test access right',

			pass => { exists_in => { firstname => 1, lastname => 1, email => 1 } },

			fail => { exists_in => [qw(blabla)] }

		);

package main;

	{
		my $accesstester = new Bouncer( );

		push @{ $accesstester->tests }, new Bouncer::Test( field => 'method', type => 'positivliste' );

		my $user = Obsessor->new();

			# CAVE: target is an Class::Maker::Examples::Obsessor method (the only one)

		$user->Obsessor::target( new User( firstname => 'Murat', lastname => 'Uenalan' ) );

		push @{ $user->bouncers }, $accesstester;

			# bouncer won't reject email, firstname or lastname, because they're in the pass-list

		$user->email( 'muenalan@cpan.org' );

		$user->firstname( 'Murat' );

		$user->lastname( 'Murat' );

			# bouncer rejects 'blabla' because it's in fail-list

		$user->blabla();

		print Dumper $user;
	}

=head1 DESCRIPTION

Class::Maker::Examples::Obsessor has nothing to do with a http-server. But, in the very principle
it behaves like it. It serves a target class/object and has all might about it.
This can be used i.e. to restrict/log/bench/forward/obscure/cache/.. the access
to the target.
After you plug a target to an Class::Maker::Examples::Obsessor, the resulting object behaves like
the original target in terms of methodcalls. But a ref()-call would reveal the object
beeing an Class::Maker::Examples::Obsessor in real. Also caller() would be influenced (unfortunately).

=head2 EXPORT

None by default.

=head2 EXAMPLE "Access restriction"

=head1 AUTHOR

Murat Ünalan, <muenalan@cpan.org>

=head1 SEE ALSO

perl(1).

=cut