package Terse::Controller;
use strict;
use warnings;
use attributes ();
use base 'Terse';
use B 'svref_2object';

sub MODIFY_CODE_ATTRIBUTES {
	my ($package, $coderef, @attributes, @disallowed) = @_;
	my $name = svref_2object($coderef)->GV->NAME;
	my %attr = PARSE_ATTRIBUTES($name, @attributes);
	push @{ $Terse::Controller::dispatcher{$package}{$attr{req}} }, \%attr;
	return ();
}

sub FETCH_CODE_ATTRIBUTES {
	my ($class, $coderef) = @_;
	my $cv = svref_2object($coderef);
	return @{$Terse::Controller::dispatcher{$class}{ $cv->GV->NAME }};
}

sub PARSE_ATTRIBUTES {
	my ($sub, @attributes) = @_;
	my %attr = (
		req => $sub,
		callback => $sub
	);
	for my $attribute (@attributes) {
		if ($attribute =~ m/^\s*params\((.*)\)\s*$/) {
			$attr{params} = { eval $1 };
		}
		elsif ($attribute =~ m/^\s*([^\s\(]+)\s*\(([\s\'\"]*?)(.*)([\s\'\"]*?)\)/) {
			$attr{$1} = $3;		
		} 
		else {
			$attr{$attribute} = 1; 
		}
	}
	return %attr;
}

sub dispatch {
	my ($self, $req, $t, @params) = @_;
	my $package = ref $self || $self;
	my $dispatcher = $Terse::Controller::dispatcher{$package}{$req};
	if (!$dispatcher) {
		$t->logError('Invalid request', 400);
		return;
	}
	my $dispatch;
	DISPATCH: for my $candidate (reverse @{$dispatcher}) {
		if ($candidate->{params}) {
			for my $param (keys %{$candidate->{params}}) {
				next DISPATCH if (!$t->params->{$param});
				next DISPATCH unless $self->_partial_match(
					$t->params->{$param}, 
					$candidate->{params}->{$param}
				);
			}
		}
		if ($candidate->{any}) {
			$dispatch = $candidate;
			last;
		}
		if ($candidate->{lc($t->request->method)}) {
			$dispatch = $candidate;
			last;
		}
	}
	$dispatch = $self->dispatch_hook($dispatch) if $self->can('dispatch_hook'); 
	my $callback = $dispatch->{callback};
	if (!$callback) {
		$t->logError('No callback found to dispatch the request', 400);
		return;
	}
	return $self->$callback($t, @params);
} 

sub _partial_match {
	my ($self, $param, $spec) = @_;
	return 0 if !$param && $spec;
	my ($ref, $match) = (ref $spec, 1);
	if (!$ref) {
		$match = ref $param ? 0 : $param =~ m/^$spec$/;
	} elsif ($ref eq 'ARRAY') {
		for (my $i = 0; $i < scalar @{$spec}; $i++) {
			$match = $self->_partial_match($param->[$i], $spec->[$i]);
			last if (!$match);
		}
	} elsif ($ref eq 'HASH') {
		for my $key ( keys %{$spec} ) {
			$match = $self->_partial_match($param->{$key}, $spec->{$key});
			last if (!$match);
		}
	}
	return $match;
}

1;

__END__;


=head1 NAME

Terse::Controller - controllers made simple.

=head1 VERSION

Version 0.06

=cut

=head1 SYNOPSIS

	package Stocks;

	use base 'Terse::Controller';

	sub login :any {
		return 1;
	}

	sub auth_prevent :req(auth) :any {
		return 0;
	}

	sub auth :get :post {
		return 1;
	}

	sub purchase :get {
		... #1
	}
	
	sub purchase_virtual :get(purchase) :params(virtual => 1) {
		... #2
	}

	sub purchase_post :req(purchase) :post {
		... # 3
	}

	sub purchase_virtual_post :req(purchase) :post :params(virtual => 1) {
		... # 4
	}

	1;

	.... psgi ...

	use Terse;
	use Stocks;
	our $api = Stocks->new();

	sub {
		my ($env) = (shift);
		Terse->run(
			plack_env => $env,
			application => $api,
		);
	};

	....

	plackup Stocks.psgi

	GET http://localhost:5000/?req=purchase  #1
	POST http://localhost:5000/ {"req":"purchase"} #2

	GET http://localhost:5000/?req=purchase&virtual=1 #3
	POST http://localhost:5000/ {"req":"purchase", "virtual":1} #4

=cut

=head1 AUTHOR

LNATION, C<< <email at lnation.org> >>

=head1 LICENSE AND COPYRIGHT

L<Terse>.

=cut
