#!/usr/bin/perl

package Context::Handle;
use base qw/Exporter/;

use strict;
use warnings;

use Want ();
use Carp qw/croak/;

use Context::Handle::RV::Scalar;
use Context::Handle::RV::Void;
use Context::Handle::RV::List;
use Context::Handle::RV::Bool;
use Context::Handle::RV::RefHash;
use Context::Handle::RV::RefArray;
use Context::Handle::RV::RefScalar;
use Context::Handle::RV::RefCode;
use Context::Handle::RV::RefObject;

BEGIN {
	our @EXPORT_OK = qw/context_sensitive/;
}

our $VERSION = "0.01";

sub context_sensitive (&) {
	my $code = shift;
	__PACKAGE__->new( $code, 1 );
}

sub new {
	my $pkg = shift;
	my $code = shift;
	my $caller_level = @_ ? 1 + shift : 1;

	my $self = bless {
		uplevel => $caller_level,
		want_reftype => Want::wantref( $caller_level + 1 ),
		want_count => Want::want_count($caller_level),
		want_wantarray => Want::wantarray_up($caller_level),
		want_bool => Want::want_uplevel($caller_level, "BOOL"),
		want_assign => [ Want::wantassign( $caller_level + 1 ) ],
		want_lvalue => Want::want_lvalue( $caller_level ),
	}, $pkg;

	$self->eval( $code) ;

	$self;
}

sub bool {
	my $self = shift;
	$self->{want_bool} && defined $self->{want_wantarray};
}

sub void {
	my $self = shift;
	not defined $self->{want_wantarray};
}

sub scalar {
	my $self = shift;
	defined $self->{want_wantarray} && $self->{want_wantarray} == 0;
}

sub list {
	my $self = shift;
	$self->{want_wantarray};
}

sub refarray {
	my $self = shift;
	$self->{want_reftype} eq 'ARRAY';
}

sub refhash {
	my $self = shift;
	$self->{want_reftype} eq 'HASH';
}

sub refscalar {
	my $self = shift;
	$self->{want_reftype} eq 'SCALAR';
}

sub refobject {
	my $self = shift;
	$self->{want_reftype} eq 'OBJECT';
}

sub refcode {
	my $self = shift;
	$self->{want_reftype} eq 'CODE';
}

sub refglob {
	my $self = shift;
	$self->{want_reftype} eq 'GLOB';
}


sub rv_subclass {
	my $self = shift;

	if ( $self->scalar ) {
		for (qw/RefArray RefScalar RefHash RefObject RefCode RefGlob/) {
			my $meth = lc;
			return $_ if $self->$meth;
		}

		return "Bool" if $self->bool;

		return "Scalar";
	} else {
		$self->$_ and return ucfirst for qw/void list/;
	}

	die "dunno how to do this context.";
}

sub mk_rv_container {
	my $self = shift;
	my $code = shift;

	my $subclass = $self->rv_subclass;
	"Context::Handle::RV::$subclass"->new($code);
}

sub eval {
	my $self = shift;
	my $code = shift;

	$self->{rv_container} = $self->mk_rv_container($code);
}

sub rv_container {
	my $self = shift;
	$self->{rv_container};
}

sub value {
	my $self = shift;
	$self->rv_container->value;
}

sub return {
	my $self = shift;
	Want::double_return();
	$self->value;
}


__PACKAGE__;

__END__

=pod

=head1 NAME

Context::Handle - A convenient context propagation proxy thingy.

=head1 SYNOPSIS

	use Context::Handle qw/context_sensitive/;

	sub wrapping {
		my $rv = context_sensitive {
			$some_thing->method(); # anything really
		};

		# you can do anything here

		$rv->return; # returns the value in the right context

		# not reached
	}

=head1 DESCRIPTION

This module lets you delegate to another method and return the value without
caring about context propagation.

The level of support is tied to what L<Want> does - this module tries to make
all the distinctions Want can make fully supported, for example array
dereference context, boolean context, etc.

=head1 EXPORTS

Nothing is exported by default.

=over 4

=item context_sensitive BLOCK

This is a convenience shortcut that calls C<new>

=back

=head1 METHODS

=head2 Regular Usage

=over 4

=item new $code

This method invokes $code in the calling sub's context, and returns an object
that saves the return value.

=item rv_container

This instance method returns the return value container object. The only useful
methods for the RV containers is C<value>, which has a delegator anyway.

=item value

This returns the value from the C<rv_container>

=item return

This (ab)uses L<Want> to perform a double return.

Saying

	$rv->return;

is just like

	return $rv->value;

=back

=head2 Introspection

Incidientially due to the needs of the wrapping layer this module also provides
an OO interface to L<Want>, more or less ;-)

=over 4

=item bool

=item void

=item scalar

=item list

=item refarray

=item refhash

=item refscalar

=item refobject

=item refcode

=item refglob

All of these methods return boolean values, with respect to the 

=back

=head1 TODO

=over 4

=item *

pseudoboolean context - the right side of && and the left side of || evaulate
in boolean context, but still return a meaningful value.

=item *

Glob assignment context. I'm not sure how to make the value propagate back once
it's been assigned to the glob - it's hard to know what it is without
inspecting the slots and that's kinda tricky.

=item *

Lvalue assignment

=item *

use L<Sub::Uplevel> to hide the wrapping

=item *

context arity - L<Want>'s count stuff. This can probably be done using
@list[0..$x] = (...), but might need to be emulated with eval. See
C<perldoc -f split>.

=back

=head1 ACKNOWLEGMENTS

Robin Houston for L<Want> and lots of help by email

=head1 AUTHOR

Yuval Kogman <nothingmuch@woobling.org>

=head1 COPYRIGHT & LICENSE

	Copyright (c) 2006 the aforementioned authors. All rights
	reserved. This program is free software; you can redistribute
	it and/or modify it under the same terms as Perl itself.

=cut