The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Catalyst::Controller::Constraints::Argument;
use warnings;
use strict;

use Moose;

has 'name',         is          => 'rw',
                    isa         => 'Value',
                    required    => 1,
                    ;
has 'constraint',   is          => 'rw',
                    isa         => 'Object',
                    predicate   => 'has_constraint',
                    ;
has 'action',       is          => 'rw',
                    isa         => 'Object',
                    weak_ref    => 1,
                    required    => 1,
                    ;
has 'controller',   is          => 'rw',
                    isa         => 'Object',
                    weak_ref    => 1,
                    required    => 1,
                    ;
has 'autostash',    is          => 'rw',
                    isa         => 'Bool',
                    default     => sub { 0 },
                    ;
has 'parameter',    is          => 'rw',
                    isa         => 'Value',
                    predicate   => 'has_parameter',
                    ;

=head1 METHODS

=head2 takes

Delegates to C<$self-E<gt>constraint-E<gt>takes>.

=cut

sub takes {
    my ( $self ) = @_;
    return( $self->has_constraint ? $self->constraint->takes : 1 );
}

=head2 gives

Delegates to C<$self-E<gt>constraint-E<gt>gives>.

=cut

sub gives {
    my ( $self ) = @_;
    return( $self->has_constraint ? $self->constraint->gives : 1 );
}

=head2 initialize

Initializes constraints and parameters.

=cut

sub initialize {
    my ( $self ) = @_;

    my $name = $self->name;
    if ( $name =~ s/\*$// ) {
        # arguments that end in a '*' will be autostashed on
        # preparation.

        $self->autostash(1);
        $self->name( $name );
    }

    1;
}

=head2 prepare_value

Takes value from request and returns the finished one.

=cut

sub prepare_value {
    my ( $self, $c, $value ) = @_;

    if ( $self->has_constraint ) {
        # if a constraint was specified with this argument, we run it.
        # this may throw an exception and end this request's journey.
        # a possible parameter is also passed through %_.

        local %_ = (
            param       => $self->parameter,
            has_param   => $self->has_parameter,
			ctx			=> $c,
			ctrl		=> $self->controller,
        );
        $value = $self->constraint->prepare_value( $self, $c, $value );
    }

    if ( $self->autostash ) {
        # when we're supposed to autostash the value, we just do that.
        # depending on the values of 'takes' and 'gives' we're setting
        # just one value, not the array reference.

        $c->stash->{ $self->name } = (
            (       $self->gives == 1
              and   ref $value eq 'ARRAY' ) ? $value->[0] : $value );
    }

    return $value;
}

=head1 AUTHOR

Robert 'phaylon' Sedlacek - C<E<lt>phaylon@dunkelheit.atE<gt>>

=head1 LICENSE AND COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut

1;