libjifty-perl 1.10518+dfsg-1ubuntu2 / usr / share / perl5 / Jifty / Action.pm

use warnings;
use strict;

package Jifty::Action;

=head1 NAME

Jifty::Action - The ability to Do Things in the framework

=head1 SYNOPSIS

    package MyApp::Action::Foo;
    use Jifty::Param::Schema;
    use Jifty::Action schema {

    param bar =>
        type is 'checkbox',
        label is 'Want Bar?',
        hints is 'Bar is this cool thing that you really want.',
        default is 0;

    };
  
    sub take_action {
        ...
    }
  
  1;

=head1 DESCRIPTION

C<Jifty::Action> is the superclass for all actions in Jifty.
Action classes form the meat of the L<Jifty> framework; they
control how form elements interact with the underlying model.

See also L<Jifty::Action::Record> for data-oriented actions, 
L<Jifty::Result> for how to return values from actions.

See L<Jifty::Param::Schema> for more details on the declarative
syntax.

See L<Jifty::Manual::Actions> for examples of using actions.

=cut


use base qw/Jifty::Object Class::Accessor::Fast Class::Data::Inheritable/;

__PACKAGE__->mk_accessors(qw(moniker argument_values values_from_request order result sticky_on_success sticky_on_failure));
__PACKAGE__->mk_classdata(qw/PARAMS/);

=head1 COMMON METHODS

These common methods provide the basic guts for the action.

=head2 new 

B<Do not call this directly>; always go through C<< Jifty->web->new_action >>! 

This method constructs a new action. Subclasses who need do custom
initialization should start with:

    my $class = shift;
    my $self = $class->SUPER::new(@_)

The arguments that this will be called with include:

=head3 Arguments

=over

=item moniker

The L<moniker|Jifty::Manual::Glossary/moniker> of the action.  Defaults to an
autogenerated moniker.

=item order

An integer that determines the ordering of the action's execution.
Lower numbers occur before higher numbers.  Defaults to 0.

=item arguments

A hash reference of default values for the
L<arguments|Jifty::Manual::Glossary/argument> of the action.  Defaults
to none.

=item sticky_on_failure

A boolean value that determines if the form fields are
L<sticky|Jifty::Manual::Glossary/sticky> when the action fails.
Defaults to true.

=item sticky_on_success

A boolean value that determines if the form fields are
L<sticky|Jifty::Manual::Glossary/sticky> when the action succeeds.
Defaults to false.

=back

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    my %args = (
        order      => undef,
        arguments  => {},
        request_arguments => {},
        sticky_on_success => 0,
        sticky_on_failure => 1,
        current_user => undef,
        @_);

    # Setup current user according to parameter or pickup the actual
    if ($args{'current_user'}) {
        $self->current_user($args{current_user});
    } else {
        $self->_get_current_user();
    }

    # If given a moniker, validate/sanitize it
    if ( $args{'moniker'} ) {

        # XXX Should this be pickier about sanitized monikers?

        # Monikers must not contain semi-colons
        if ( $args{'moniker'} =~ /[\;]/ ) {

            # Replace the semis with underscores and warn
            $args{'moniker'} =~ s/[\;]/_/g;
            $self->log->warn(
                "Moniker @{[$args{'moniker'}]} contains invalid characters. It should not contain any ';' characters. "
                    . "It has been autocorrected, but you should correct your code"
            );
        }

        # Monikers must not start with a digit
        if ( $args{'moniker'} =~ /^\d/ ) {

            # Stick "fixup-" to the front and warn
            $args{'moniker'} = "fixup-" . $args{'moniker'};
            $self->log->warn(
                "Moniker @{[$args{'moniker'}]} contains invalid characters. It can not begin with a digit. "
                    . "It has been autocorrected, but you should correct your code"
            );

        }
    }

    # Setup the moniker and run order
    $self->moniker($args{'moniker'} || $self->_generate_moniker);
    $self->order($args{'order'});

    # Fetch any arguments from a passed in request
    my $action_in_request = Jifty->web->request->action( $self->moniker );
    if ( $action_in_request and $action_in_request->arguments ) {
        $args{'request_arguments'} = $action_in_request->arguments;
    }

    # Setup the argument values with the new_action arguments taking precedent
    $self->argument_values( { %{ $args{'request_arguments' } }, %{ $args{'arguments'} } } );

    # Track how an argument was set, again new_action args taking precedent
    $self->values_from_request({});
    $self->values_from_request->{$_} = 1 for keys %{ $args{'request_arguments' } };
    $self->values_from_request->{$_} = 0 for keys %{ $args{'arguments' } };
    
    # Place this actions result in the response result if already processed
    $self->result(Jifty->web->response->result($self->moniker) || Jifty::Result->new);
    $self->result->action_class(ref($self));

    # Remember stickiness
    $self->sticky_on_success($args{sticky_on_success});
    $self->sticky_on_failure($args{sticky_on_failure});

    return $self;
}

=head2 _generate_moniker 

Construct a moniker for a new (or soon-to-be-constructed) action that
did not have an explicit moniker specified.  The algorithm is simple:
We snapshot the call stack, prefix it with the action class, and then
append it with an per-request autoincrement counter in case the same
class/stack is encountered twice, which can happen if the programmer
placed a C<new_action> call inside a loop.

Monikers generated this way are guaranteed to work across requests.

=cut

sub _generate_moniker {
    my $self = shift;

    # We use Digest::MD5 to generate the moniker
    use Digest::MD5 qw(md5_hex);

    # Use information from the call stack as the data for the digest 
    my $frame = 1;
    my @stack = (ref($self) || $self);
    while (my ($pkg, $filename, $line) = caller($frame++)) {
        push @stack, $pkg, $filename, $line;
    }

    # Generate the digest that forms the basis of the auto-moniker
    my $digest = md5_hex("@stack");

    # Increment the per-request moniker digest counter, for the case of looped action generation
    # We should always have a stash. but if we don't, fake something up
    # (some hiveminder tests create actions outside of a Jifty::Web)
    # Multiple things happening here that need to be noted:
    #  
    #  1. We have a per-request moniker digest counter, which handles the
    #     highly unlikely circumstance that the same digest were hit twice
    #     within the same request.
    #
    #  2. We should always have a stash, but sometimes we don't. (Specifically,
    #     some Hiveminder tests create actions outside of a Jifty::Web, which
    #     don't.) In that case, add more random data at the end and cross our
    #     fingers that we don't hit that one in a billion (or actually one in a
    #     significantly larger than a billion odds here).

    # Create a serial number that prevents collisions within a request
    my $serial = Jifty->handler->stash 
        ? ++(Jifty->handler->stash->{monikers}{$digest}) 
        : rand();

    # Build the actual moniker from digest + serial
    my $moniker = "auto-$digest-$serial";
    $self->log->debug("Generating moniker $moniker from stack for $self");

    return $moniker;
}

=head2 arguments

B<Note>: this API is now deprecated in favour of the declarative syntax
offered by L<Jifty::Param::Schema>.

This method, along with L</take_action>, is the most commonly
overridden method.  It should return a hash which describes the
L<arguments|Jifty::Manual::Glossary/argument> this action takes:

  {
    argument_name    => {label => "properties go in this hash"},
    another_argument => {mandatory => 1}
  }

Each argument listed in the hash will be turned into a
L<Jifty::Web::Form::Field> object.  For each argument, the hash that
describes it is used to set up the L<Jifty::Web::Form::Field> object by
calling the keys as methods with the values as arguments.  That is, in
the above example, Jifty will run code similar to the following:

  # For 'argument_name'
  $f = Jifty::Web::Form::Field->new;
  $f->name( "argument_name" );
  $f->label( "Properties go in this hash" );

If an action has parameters that B<must> be passed to it to execute,
these should have the L<constructor|Jifty::Manual::Glossary/constructor>
property set.  This is separate from the
L<mandatory|Jifty::Manual::Glossary/mandatory> property, which deal with
requiring that the user enter a value for that field.


=cut

sub arguments {
    my  $self= shift;
    return($self->PARAMS || {});
}

=head2 run

This routine, unsurprisingly, actually runs the action.

If the result of the action is currently a success (validation did not
fail), C<run> calls L</take_action>, and finally L</cleanup>.

If you're writing your own actions, you probably want to override
C<take_action> instead.

=cut

sub run {
    my $self = shift;
    $self->log->debug("Running action ".ref($self) . " " .$self->moniker);

    # We've already had a validation failure. STOP!
    unless ($self->result->success) {
        $self->log->debug("Not taking action, as it doesn't validate");

        # dump field warnings and errors to debug log
        foreach my $what (qw/warnings errors/) {
            my $f = "field_" . $what;
            my @r =
                map {
                    $_ . ": " . $self->result->{$f}->{$_}
                } grep { $self->result->{$f}->{$_} }
                    keys %{ $self->result->{$f} };
            $self->log->debug("Action result $what:\n\t", join("\n\t", @r)) if (@r);
        }

        return;
    }

    # Made it past validation, continue...
    $self->log->debug("Taking action ".ref($self) . " " .$self->moniker);

    # Take the action (user-defined)
    my $ret = $self->take_action;
    $self->log->debug("Result: ".(defined $ret ? $ret : "(undef)"));
    
    # Perform post action clean-up (user-defined)
    $self->cleanup;
}

=head2 validate

Checks authorization with L</check_authorization>, calls C</setup>,
canonicalizes and validates each argument that was submitted, but
doesn't actually call L</take_action>.

The outcome of all of this is stored on the L</result> of the action.

=cut

sub validate {
    my $self = shift;
    $self->check_authorization || return;
    $self->setup || return;
    $self->_canonicalize_arguments;
    $self->_validate_arguments;
}

=head2 check_authorization

Returns true if whoever invoked this action is authorized to perform
this action. 

By default, always returns true.

=cut

sub check_authorization { 1; }

=head2 setup

C<setup> is expected to return a true value, or
L</run> will skip all other actions.

By default, does nothing.

=cut

sub setup { 1; }

=head2 take_action

Do whatever the action is supposed to do.  This and
L</arguments> are the most commonly overridden methods.

By default, does nothing.

The return value from this method is NOT returned. (Instead, you
should be using the L</result> object to store a result).

=cut

sub take_action { 1; }

=head2 cleanup

Perform any action-specific cleanup.  By default, does nothing.

Runs after L</take_action> -- whether or not L</take_action> returns success.

=cut

sub cleanup { 1; }

=head2 moniker

Returns the L<moniker|Jifty::Manual::Glossary/moniker> for this action.

=head2 argument_value ARGUMENT [VALUE]

Returns the value from the argument with the given name, for this
action.  If I<VALUE> is provided, sets the value.

=cut

sub argument_value {
    my $self = shift;
    my $arg = shift;

    # Not only get it, but set it
    if(@_) {
        $self->values_from_request->{$arg} = 0;
        $self->argument_values->{$arg} = shift;
    }

    # Get it
    return $self->argument_values->{$arg};
}

=head2 has_argument ARGUMENT

Returns true if the action has been provided with an value for the
given argument, including a default_value, and false if none was ever
passed in.

=cut

sub has_argument {
    my $self = shift;
    my $arg = shift;

    return exists $self->argument_values->{$arg};
}

=head2 form_field ARGUMENT

Returns a L<Jifty::Web::Form::Field> object for this argument.  If
there is no entry in the L</arguments> hash that matches the given
C<ARGUMENT>, returns C<undef>.

=cut

sub form_field {
    my $self = shift;
    my $arg_name = shift;

    # Determine whether we want reads or write on this field
    my $mode = $self->arguments->{$arg_name}{'render_mode'};
    $mode = 'update' unless $mode && $mode eq 'read';

    # Return the widget
    $self->_form_widget( argument => $arg_name,
                         render_mode => $mode,
                         @_);
}


=head2 form_value ARGUMENT

Returns a L<Jifty::Web::Form::Field> object that renders a display
value instead of an editable widget for this argument.  If there is no
entry in the L</arguments> hash that matches the given C<ARGUMENT>,
returns C<undef>.

=cut

sub form_value {
    my $self = shift;
    my $arg_name = shift;

    # Return the widget, but in read mode
    $self->_form_widget( argument => $arg_name,
                         render_mode => 'read',
                         @_);

}

# Generalized helper for the two above
sub _form_widget {
    my $self = shift;
    my %args = (
        argument => undef,
        render_mode => 'update',
        @_,
    );
    my $cache_key = join '!!',
      map { $_ => defined $args{$_} ? $args{$_} : '' } keys %args;

    # Setup the field name
    my $field = $args{'argument'};

    # This particular field hasn't been added to the form yet
    if ( not exists $self->{_private_form_fields_hash}{$cache_key} ) {
        my $field_info = $self->arguments->{$field};
        # The field name is not known by this action
        unless ($field_info) {
            local $Log::Log4perl::caller_depth += 2;
            $self->log->warn("$field isn't a valid field for $self");
            return;
        }
        # It is in fact a form field for this action

        my $sticky = 0;
        # $sticky can be overridden per-parameter
        if ( defined $field_info->{sticky} ) {
            $sticky = $field_info->{sticky};
        }
        # Check stickiness if the values came from the request
        elsif (Jifty->web->response->result($self->moniker)) {
            $sticky = 1 if $self->sticky_on_failure and $self->result->failure;
            $sticky = 1 if $self->sticky_on_success and $self->result->success;
        }


        # form_fields overrides stickiness of what the user last entered.
        my $default_value;
        $default_value = $field_info->{'default_value'}
          if exists $field_info->{'default_value'};
        $default_value = $self->argument_value($field)
          if $self->has_argument($field) && !$self->values_from_request->{$field};

        my %field_args = (
            %$field_info,
            action        => $self,
            name          => $field,
            sticky        => $sticky,
            sticky_value  => $self->argument_value($field),
            default_value => $default_value,
            render_mode   => $args{'render_mode'},
            %args,
        );

        # Add the form field to the cache
        $self->{_private_form_fields_hash}{$cache_key}
            = Jifty::Web::Form::Field->new(%field_args);
    }

    return $self->{_private_form_fields_hash}{$cache_key};
}

=head2 hidden ARGUMENT VALUE

A shortcut for specifying a form field C<ARGUMENT> which should render
as a hidden form field, with the default value C<VALUE>.

=cut

sub hidden {
    my $self = shift;
    my ($arg, $value, @other) = @_;

    # Return the control as a hidden widget
    $self->form_field( $arg, render_as => 'hidden', default_value => $value, @other);
}

=head2 order [INTEGER]

Gets or sets the order that the action will be run in.  This should be
an integer, with lower numbers being run first.  Defaults to zero.

=head2 result [RESULT]

Returns the L<Jifty::Result> method associated with this action.  If
an action with the same moniker existed in the B<last> request, then
this contains the results of that action.

=head2 register

Registers this action as being present, by outputting a snippet of
HTML.  This expects that an HTML form has already been opened.  Note
that this is not a guarantee that the action will be run, even if the
form is submitted.  See L<Jifty::Request> for the definition of
"L<active|Jifty::Manual::Glossary/active>" actions.

Normally, L<Jifty::Web/new_action> takes care of calling this when it
is needed.

=cut

sub register {
    my $self = shift;

    # Add information about the action to the form
    Jifty->web->out( qq!<div class="hidden"><input type="hidden"! .
                       qq! name="@{[$self->register_name]}"! .
                       qq! id="@{[$self->register_name]}"! .
                       qq! value="@{[ref($self)]}"! .
                       qq! /></div>\n! );

    # Add all the default values as hidden fields to the form
    my %args = %{$self->arguments};
    while ( my ( $name, $info ) = each %args ) {
        next unless $info->{'constructor'};
        Jifty::Web::Form::Field->new(
            %$info,
            action        => $self,
            input_name    => $self->fallback_form_field_name($name),
            sticky        => 0,
            default_value => ($self->argument_value($name) || $info->{'default_value'}),
            render_as     => 'Hidden'
        )->render();
    }

    return '';
}

=head2 render_errors

Render any the L<Jifty::Result/error> of this action, if any, as HTML.
Returns nothing.

=cut

sub render_errors {
    my $self = shift;
    
    # Render the span that contians errors
    if (defined $self->result->error) {
        # XXX TODO FIXME escape?
        Jifty->web->out( '<div class="form_errors">'
                . '<span class="error">'
                . $self->result->error
                . '</span>'
                . '</div>' );
    }
    return '';
}

=head2 button arguments => { KEY => VALUE }, PARAMHASH

Create and render a button.  It functions nearly identically like
L<Jifty::Web/link>, except it takes C<arguments> in addition to
C<parameters>, and defaults to submitting this L<Jifty::Action>.
Returns nothing. 

Recommended reading: L<Jifty::Web::Form::Element>, where most of 
the cool options to button and other things of its ilk are documented.

=cut

sub button {
    my $self = shift;
    my %args = ( arguments => {},
                 submit    => $self,
                 register  => 0,
                 @_);

    # The user has asked to register the action while we're at it
    if ($args{register}) {

        # If they ask us to register the action, do so
        Jifty->web->form->register_action( $self );
        Jifty->web->form->print_action_registration($self->moniker);
    } 
    
    # Add whatever additional arguments they've requested to the button
    $args{parameters}{$self->form_field_name($_)} = $args{arguments}{$_}
      for keys %{$args{arguments}};

    # Render us a button
    Jifty->web->link(%args);
}

=head3 return PARAMHASH

Creates and renders a button, like L</button>, which additionally
defaults to calling the current continuation.

Takes an additional argument, C<to>, which can specify a default path
to return to if there is no current continuation.

=cut

sub return {
    my $self = shift;
    my %args = (@_);

    # Fetch the current continuation or build a new one
    my $continuation = Jifty->web->request->continuation;
    if (not $continuation and $args{to}) {
        $continuation = Jifty::Continuation->new(request => Jifty::Request->new(path => $args{to}));
    }
    delete $args{to};

    # Render a button that will call the continuation
    $self->button( call => $continuation, %args );
}

=head1 NAMING METHODS

These methods return the names of HTML form elements related to this
action.

=head2 register_name

Returns the name of the "registration" query argument for this action
in a web form.

=cut

sub register_name {
    my $self = shift;
    return 'J:A-' . (defined $self->order ? $self->order . "-" : "") .$self->moniker;
}

# prefixes a fieldname with a given prefix and follows it with the moniker
sub _prefix_field {
    my $self = shift;
    my ($field_name, $prefix) = @_;
    return join("-", $prefix, $field_name, $self->moniker);
}

=head2 form_field_name ARGUMENT

Turn one of this action's L<arguments|Jifty::Manual::Glossary/arguments> into
a fully qualified name; takes the name of the field as an argument.

=cut

sub form_field_name {
    my $self = shift;
    return $self->_prefix_field(shift, "J:A:F");
}

=head2 fallback_form_field_name ARGUMENT

Turn one of this action's L<arguments|Jifty::Manual::Glossary/arguments> into
a fully qualified "fallback" name; takes the name of the field as an
argument.

This is specifically to support checkboxes, which only show up in the
query string if they are checked.  Jifty creates a checkbox with the
value of L<form_field_name> as its name and a value of 1, and a hidden
input with the value of L<fallback_form_field_name> as its name and a
value of 0; using this information, L<Jifty::Request> can both
determine if the checkbox was present at all in the form, as well as
its true value.

=cut

sub fallback_form_field_name {
    my $self = shift;
    return $self->_prefix_field(shift, "J:A:F:F");
}

=head2 error_div_id ARGUMENT

Turn one of this action's L<arguments|Jifty::Manual::Glossary/arguments> into
the id for the div in which its errors live; takes name of the field
as an argument.

=cut

sub error_div_id {
  my $self = shift;
  my $field_name = shift;
  return 'errors-' . $self->form_field_name($field_name);
}

=head2 warning_div_id ARGUMENT

Turn one of this action's L<arguments|Jifty::Manual::Glossary/arguments> into
the id for the div in which its warnings live; takes name of the field
as an argument.

=cut

sub warning_div_id {
  my $self = shift;
  my $field_name = shift;
  return 'warnings-' . $self->form_field_name($field_name);
}

=head2 canonicalization_note_div_id ARGUMENT

Turn one of this action's L<arguments|Jifty::Manual::Glossary/arguments> into
the id for the div in which its canonicalization notes live; takes name of the field
as an argument.

=cut

sub canonicalization_note_div_id {
  my $self = shift;
  my $field_name = shift;
  return 'canonicalization_note-' . $self->form_field_name($field_name);
}

=head1 VALIDATION METHODS

=head2 argument_names

Returns the list of argument names.  This information is extracted
from L</arguments>.

=cut

sub argument_names {
    my $self      = shift;
    my %arguments = %{ $self->arguments };
    return (
        sort {
            (($arguments{$a}->{'sort_order'} ||0 ) <=> ($arguments{$b}->{'sort_order'} || 0))
                || (($arguments{$a}->{'name'} || '') cmp ($arguments{$b}->{'name'} ||'' ))
                || $a cmp $b
            } keys %arguments
    );
}

=head2 _canonicalize_arguments

Canonicalizes each of the L<arguments|Jifty::Manual::Glossary/arguments> that
this action knows about.

This is done by calling L</_canonicalize_argument> for each field
described by L</arguments>.

=cut

# XXX TODO: This is named with an underscore to prevent infinite
# looping with arguments named "argument" or "arguments".  We need a
# better solution.
sub _canonicalize_arguments {
    my $self   = shift;

    # For each, canonicalize them all
    $self->_canonicalize_argument($_)
      for $self->argument_names;
}


=head2 _canonicalize_argument ARGUMENT

Canonicalizes the value of an L<argument|Jifty::Manual::Glossary/argument>.
If the argument has an attribute named B<canonicalizer>, call the
subroutine reference that attribute points points to.

If it doesn't have a B<canonicalizer> attribute, but the action has a
C<canonicalize_I<ARGUMENT>> function, also invoke that function.

If neither of those are true, by default canonicalize dates using
_canonicalize_date

Note that it is possible that a canonicalizer will be called multiple
times on the same field -- canonicalizers should be careful to do
nothing to already-canonicalized data.

=cut

# XXX TODO: This is named with an underscore to prevent infinite
# looping with arguments named "argument" or "arguments".  We need a
# better solution.
sub _canonicalize_argument {
    my $self  = shift;
    my $field = shift;

    # Setup some variables
    my $field_info = $self->arguments->{$field};
    my $value = $self->argument_value($field);
    my $default_method = 'canonicalize_' . $field;

    # XXX TODO: Do we really want to skip undef values?
    return unless defined $value;

    # Do we have a valid canonicalizer for this field?
    if ( $field_info->{canonicalizer}
        and defined &{ $field_info->{canonicalizer} } ) {
        
        # Run it, sucka
        $value = $field_info->{canonicalizer}->( $self, $value, $self->argument_values, $self->_extra_canonicalizer_args );
    } 
    
    # How about a method named canonicalize_$field?
    elsif ( $self->can($default_method) ) {

        # Run that, foo'
        $value = $self->$default_method( $value, $self->argument_values, $self->_extra_canonicalizer_args );
    } 
    
    # Or is it a date?
    elsif (   defined( $field_info->{render_as} )
             && lc( $field_info->{render_as} ) eq 'date') {

        # Use the default date canonicalizer, Mr. T!
        $value = $self->_canonicalize_date( $value, $self->argument_values, $self->_extra_canonicalizer_args );
    }

    $self->argument_value($field => $value);
}

=head2 _canonicalize_date DATE

Parses and returns the date using L<Jifty::DateTime::new_from_string>.

=cut

sub _canonicalize_date {
    my $self = shift;
    my $val = shift;
    return undef unless defined $val and $val =~ /\S/;
    return undef unless my $obj = Jifty::DateTime->new_from_string($val);
    return $obj->ymd;
}

=head2 _validate_arguments

Validates the form fields.  This is done by calling
L</_validate_argument> for each field described by L</arguments>

=cut

# XXX TODO: This is named with an underscore to prevent infinite
# looping with arguments named "argument" or "arguments".  We need a
# better solution.
sub _validate_arguments {
    my $self   = shift;
    
    # Validate each argument
    $self->_validate_argument($_)
      for $self->argument_names;

    return $self->result->success;
}

=head2 _validate_argument ARGUMENT

Validate your form fields.  If the field C<ARGUMENT> is mandatory,
checks for a value.  If the field has an attribute named B<validator>,
call the subroutine reference validator points to.

If the action doesn't have an explicit B<validator> attribute, but
does have a C<validate_I<ARGUMENT>> function, invoke that function.

=cut

# XXX TODO: This is named with an underscore to prevent infinite
# looping with arguments named "argument" or "arguments".  We need a
# better solution.
sub _validate_argument {
    my $self  = shift;
    my $field = shift;

    # Do nothing if we don't have a field name
    return unless $field;
    
    $self->log->debug(" validating argument $field");

    # Do nothing if we don't know what that field is
    my $field_info = $self->arguments->{$field};
    return unless $field_info;

    # Grab the current value
    my $value = $self->argument_value($field);
    
    # When it isn't even given, check if it's mandatory and whine about it
    if ( !defined $value || !length $value ) {
        if ( $field_info->{mandatory} and ($self->has_argument($field) or not defined $field_info->{default_value})) {
            return $self->validation_error( $field => _("You need to fill in the '%1' field", $field_info->{label} || $field) );
        }
    }

    # If we have a set of allowed values, let's check that out.
    if ( $value && $field_info->{valid_values} ) {
        $self->_validate_valid_values($field => $value);
        # ... but still check through a validator function even if it's in the list
        return if $self->result->field_error($field);
    }

    # the validator method name is validate_$field
    my $default_validator = 'validate_' . $field;

    # Finally, fall back to running a validator sub
    if ( $field_info->{validator}
        and defined &{ $field_info->{validator} } )
    {
        return $field_info->{validator}->( $self, $value, $self->argument_values, $self->_extra_validator_args );
    }

    # Check to see if it's the validate_$field method instead and use that
    elsif ( $self->can($default_validator) ) {
        return $self->$default_validator( $value, $self->argument_values, $self->_extra_validator_args );
    }

    # Check if we already have a failure for it, from some other field
    elsif ( $self->result->field_error($field) or $self->result->field_warning($field) ) {
        return 0;
    }

    # If none of the checks have failed so far, then it's ok
    else {
        return $self->validation_ok($field);
    }
}

=head2 _extra_validator_args

Returns a list of extra arguments to pass to validators. By default, an empty
hash reference, but subclasses can override it to pass, say, a better C<for>.

=cut

sub _extra_validator_args {
    return {};
}

=head2 _extra_canonicalizer_args

Returns a list of extra arguments to pass to canonicalizers. By default, an
empty hash reference, but subclasses can override it to pass, say, a better
C<for>.

=cut

sub _extra_canonicalizer_args {
    return {};
}

=head2 _extra_autocompleter_args

Returns a list of extra arguments to pass to autocompleters. By default, an
empty hash reference, but subclasses can override it to pass, say, a better
C<for>.

=cut

sub _extra_autocompleter_args {
    return {};
}

=head2 _autocomplete_argument ARGUMENT

Get back a list of possible completions for C<ARGUMENT>.  The list
should either be a list of scalar values or a list of hash references.
Each hash reference must have a key named C<value>.  There can also
additionally be a key named C<label> which, if present, will be used
as the user visible label.  If C<label> is not present then the
contents of C<value> will be used for the label.

If the field has an attribute named B<autocompleter>, call the
subroutine reference B<autocompleter> points to.

If the field doesn't have an explicit B<autocompleter> attribute, but
does have a C<autocomplete_I<ARGUMENT>> function, invoke that
function.


=cut

# XXX TODO: This is named with an underscore to prevent infinite
# looping with arguments named "argument" or "arguments".  We need a
# better solution.
sub _autocomplete_argument {
    my $self  = shift;
    my $field = shift;
    my $field_info = $self->arguments->{$field};
    my $value = $self->argument_value($field);

    # the method is autocomplete_$field
    my $default_autocomplete = 'autocomplete_' . $field;

    # If it's defined on the field, use that autocompleter
    if ( $field_info->{autocompleter}  )
    {
        return $field_info->{autocompleter}->( $self, $value, $self->argument_values, $self->_extra_autocompleter_args );
    }

    # If it's a method on the class, use that autocompleter
    elsif ( $self->can($default_autocomplete) ) {
        return $self->$default_autocomplete( $value, $self->argument_values, $self->_extra_autocompleter_args );
    }

    # Otherwise, return zip-zero-notta
    return();
}

=head2 valid_values ARGUMENT

Given an L<parameter|Jifty::Manual::Glossary/parameter> name, returns the
list of valid values for it, based on its C<valid_values> field.

This method returns a hash reference with a C<display> field for the string
to display for the value, and a C<value> field for the value to actually send
to the server.

(Avoid using this -- this is not the appropriate place for this logic
to be!)

=cut

sub valid_values {
    my $self = shift;
    my $field = shift;

    $self->_values_for_field( $field => 'valid' );
}

sub _validate_valid_values {
    my $self  = shift;
    my $field = shift;
    my $value = shift;

    # If you're not on the list, you can't come to the party
    unless ( grep {defined $_->{'value'} and $_->{'value'} eq $value}
        @{ $self->valid_values($field) } ) {

        return $self->validation_error(
            $field => _("That doesn't look like a correct value") );
    }

    return 1;
}

=head2 available_values ARGUMENT

Just like L<valid_values>, but if our action has a set of available
recommended values, returns that instead. (We use this to
differentiate between a list of acceptable values and a list of
suggested values)

=cut

sub available_values {
    my $self = shift;
    my $field = shift;

    $self->_values_for_field( $field => 'available' ) || $self->_values_for_field( $field => 'valid' );

}

# TODO XXX FIXME this is probably in the wrong place, logically
sub _values_for_field {
    my $self  = shift;
    my $field = shift;
    my $type = shift;

    # Check for $type_values (valid_values or available_values)
    my $vv_orig = $self->arguments->{$field}{$type .'_values'};
    local $@;

    # Try making that into a list or just return it
    my @values = eval { @$vv_orig } or return $vv_orig;

    # This is a final return list
    my @vv;

    # For each value in the *_values list
    for my $v (@values) {

        # If it's a hash, it may be a collection spec or a display/value
        if ( ref $v eq 'HASH' ) {

            # Check for a collection spec
            if ( $v->{'collection'} ) {

                # Load the display_from/value_from parameters
                my $disp = $v->{'display_from'};
                my $val  = $v->{'value_from'};

                if ($v->{'collection'}->count) {
                    unless ($v->{'collection'}->first->can($disp)) {
                        $self->log->error("Invalid 'display_from' of $disp on $field");
                    }
                    unless ($v->{'collection'}->first->can($val)) {
                        $self->log->error("Invalid 'value_from' of $val on $field");
                    }
                }

                # XXX TODO: wrap this in an eval?

                # Fetch all the record from the given collection and keep'em
                push @vv, map {
                    {
                        display => ( $_->$disp() || '' ),
                        value   => ( $_->$val()  || '' )
                    }
                } grep {$_->check_read_rights} @{ $v->{'collection'}->items_array_ref };

            }

            # Otherwise, push on the display/value hash
            else {

                # assume it's already display/value
                push @vv, $v;
            }
        }

        # Otherwise, treat plain string both display and value
        else {

            # just a string
            push @vv, { display => $v, value => $v };
        }
    }

    return \@vv;
}

=head2 validation_error ARGUMENT => ERROR TEXT, [OPTIONS]

Used to report an error during validation.  Inside a validator you
should write:

  return $self->validation_error( $field => "error");

..where C<$field> is the name of the argument which is at fault.  Any
extra C<OPTIONS> are passed through to L<Jifty::Result/field_error>.

=cut

sub validation_error {
    my $self = shift;
    my ($field, $error, %args) = @_;
    $self->log->warn("No such field '$field' -- did you forget to specify a field?")
        unless $self->arguments->{$field};

    $self->result->field_error($field => $error, %args);

    return 0;
}

=head2 validation_warning ARGUMENT => WARNING TEXT, [OPTIONS]

Used to report a warning during validation.  Inside a validator you
should write:

  return $self->validation_warning( $field => _("warning"));

..where C<$field> is the name of the argument which is at fault.  Any
extra C<OPTIONS> are passed through to L<Jifty::Result/field_warning>.

=cut

sub validation_warning {
    my $self = shift;
    my ($field, $warning, %args) = @_;
    $self->log->warn("No such field '$field' -- did you forget to specify a field?")
        unless $self->arguments->{$field};

    $self->result->field_warning($field => $warning, %args); 

    return 0;
}

=head2 validation_ok ARGUMENT, [OPTIONS]

Used to report that a field B<does> validate.  Inside a validator you
should write:

  return $self->validation_ok($field);

Any extra C<OPTIONS> are passed through to
L<Jifty::Result/field_warning> and L<Jifty::Result/field_error> when
unsetting them.

=cut

sub validation_ok {
    my $self = shift;
    my ($field, %args) = @_;
    $self->log->warn("No such field '$field' -- did you forget to specify a field?")
        unless $self->arguments->{$field};

    $self->result->field_error($field => undef, %args);
    $self->result->field_warning($field => undef, %args);

    return 1;
}

=head2 canonicalization_note ARGUMENT => NOTE

Used to send an informational message to the user from the canonicalizer.  
Inside a canonicalizer you can write:

  $self->canonicalization_note( $field => _("I changed $field for you"));

..where C<$field> is the name of the argument which the canonicalizer is 
processing

=cut

sub canonicalization_note {
    my $self = shift;
    my $field = shift;
    my $info = shift;
  
    $self->result->field_canonicalization_note($field => $info); 

    return;

}

=head2 deny REASON

When access to an action is denied by L<Jifty::API::is_allowed> 
the request handler calls this with a message.

This should mark the action as failed and store the message
but may also want to do other things (such as providing a nicer message
or logging somewhere other than the jifty logs)

=cut

sub deny {
    my $self = shift;
    my $message = shift||'';

    $self->result->failure(1);
    $self->result->message($message);

    return;
}

=head1 CUSTOMIZATION

=head2 Canonicalization

If you wish to have the data in a field normalized into a particular
format (such as changing a date into C<YYYY-MM-DD> format, adding commas
to numbers, capitalizing words, or whatever you need) you can do so
using a canonicalizer.

This is just a method titled C<canonicalize_FIELD> where C<FIELD> is
the name of the field be normalized. Here is an example:

  sub canonicalize_foo {
      my ($self, $value, $other, $metadata) = @_;

      # do something to canonicalize the value
      my $normal_form = lc($value) . '-' . $other->{other_field};
      $normal_form .= '-update' if $metadata->{for} eq 'update';
      
      return $normal_form;
  }

The first parameter to your canonicalizer will be the value to be
canonicalized. The next will be a hash reference of all the parameters
submitted with this canonicalization, so you can be smarter. Finally, the third
parameter is a hash reference of other metadata, such as C<for>, whose value
will be C<create> or C<update>.

While doing this you might also want to call the
L</canonicalization_note> to inform the client of the modification:

  my $normal_form = lc($value);
  $self->canonicalization_note( 
      foo => _('Foo values are always in lowercase.'));

If the "foo" field has "ajax canoncalizes" set in the action schema,
then this process will be performed automatically as the form is being
filled without reloading the page.

=head2 Validation

If a value must follow a certain format, you can provide a validation
method for fields to make sure that no value enters the database until
it is in a valid form.

A validation method is one named C<validate_FIELD> where C<FIELD> is
the name of the field being checked. Here is an example:

  sub validate_foo {
      my ($self, $value, $other, $metadata) = @_;

      # Check for uppercase letters
      if ($value =~ /\p{Lu}/) {
          return $self->validation_warning(
              foo => _("Foo cannot contain uppercase letters."));
      }

      # Check for -, *, +, and ?
      elsif ($value =~ /[\-\*\+\?]/) {
          return $self->validation_error(
              foo => _("Foo cannot contain -, *, +, or ?."));
      }

      return 1;
  }

Here the "foo" field should not contain uppercase letters and must not
contain the characters '-', '*', '+', or '?'. You can use
L</validation_error> and L</validation_warning> to return the results
of your validation to the user or simply return 1 to indicate a valid
value.

Note that the parameters are the same as in L</Canonicalization>.

If you just have a list of valid values, you may want to use the
C<valid_values> schema parameter to perform this task instead.

=head2 Autocompletion

Autocompletion provides a way of suggesting choices to the client
based upon partial data entry. This doesn't necessarily force the
client to use one of the choices given but gives hints in an
application specific way.

To create an autocompletion field, you implement a method named
C<autocomplete_FIELD> where C<FIELD> is the field to
autocomplete. This is generally done with fields rendered as
'Text'. Here is an example:

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

      # Be careful to validate your input! You don't want a malicious user
      # hacking your system.
      my ($match_value) = $value =~ /^(\w+)$/;

      my $foos = MyApp::Model::FooCollection->new;
      $foos->limit(
          column   => 'name',
          operator => 'LIKE',
          value    => '%$value%',
      );

      return map { $_->name } @{ $foos->items_array_ref };
  }

In this example, the "foo" field is autocompleted from names matched
from the C<MyApp::Model::Foo> table. The match, in this case, matches
any substring found in the database. I could have matched any item
that starts with the string, ends with the string, matches other
fields than the one returned, etc. It's up to you to decide.

Note also that I have untainted the value coming in to make sure a
malicious user doesn't get anyway. You should always perform a check
like this when data is coming in from an outside source.

If you need a more complicated solution, you can return the
autocompletion values as a list of hash references containing the keys
C<value> and (optionally) C<label>:

  return map { { value => $_->name, label => $_->label } }
            @{ $foos->items_array_ref };

In this case, the labels will be shown to the client, but the selected
value would be returned to your application.

=cut

=head1 SEE ALSO

L<Jifty>, L<Jifty::API>, L<Jifty::Action::Record>, L<Jifty::Result>,
L<Jifty::Param::Schema>, L<Jifty::Manual::Actions>

=head1 LICENSE

Jifty is Copyright 2005-2010 Best Practical Solutions, LLC.
Jifty is distributed under the same terms as Perl itself.

=cut

1;