package Inline::Select ;

use strict ;
use Carp ;
use Data::Dumper ;


$Inline::Select::VERSION = '0.01' ;

%Inline::Select::GROUPS = () ;


sub import {
	my $class = shift ;
	
	return $class->bind(@_) ;
}


sub register {
	my $class = shift ;
	my %args = @_ ;

	my $group = delete $args{PACKAGE} ;
	croak("PACKAGE configuration attribute not defined") unless $group ;

	my $inline = delete $args{Inline} ;
	croak("Inline configuration attribute not defined") unless $inline ;
	croak("Inline configuration attribute must be an ARRAY reference") 
		unless UNIVERSAL::isa($inline, 'ARRAY') ;

	# Registration mode
	my $language = $inline->[0] ;
	$Inline::Select::GROUPS{$group}->{$language} = $inline ;
	debug($inline) ;
}


sub bind {
	my $class = shift ;
	my %args = @_ ;

	my $group = delete $args{PACKAGE} ;
	croak("PACKAGE configuration attribute not defined") unless $group ;

	my $inline = delete $args{Inline} ;
	croak("Inline configuration attribute not defined") unless $inline ;
	croak("Inline configuration attribute must be a SCALAR") unless ! ref($inline) ;

	# Selection mode
	my $caller = caller() ;
	debug(\%Inline::Select::GROUPS) ;
	my $code = undef ;
	if ($inline !~ /^perl$/i){
		require Inline ;
		$code = <<CODE;
package $caller ;
use Inline (\@{\$Inline::Select::GROUPS{'$group'}->{'$inline'}}) ;
CODE
	}
	else {
		croak("Source must be a CODE reference in the case of the 'Perl' language") 
			unless UNIVERSAL::isa($Inline::Select::GROUPS{$group}->{$inline}->[1], 'CODE') ;
		$code = <<CODE;
package $caller ;
\$Inline::Select::GROUPS{'$group'}->{'$inline'}->[1]->() ;
CODE
	}
	debug($code) ;
	eval $code ;
	croak($@) if $@ ;
}


sub debug {
	my $msg = shift ;

	if ($ENV{PERL_INLINE_SELECT_DEBUG}){
		if (ref($msg)){
			print STDERR Dumper($msg) ;
		}
		else{
			print STDERR "$msg\n" ;
		}
	}
}



1 ;