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

    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;

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

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

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

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

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

  return $self->validation_ok($field);

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

  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;
  }

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

  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;
  }

  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 };
  }

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

use warnings;
use strict;

package Jifty::Action;

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/);

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;
}

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;
}

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

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;
}

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

sub check_authorization { 1; }

sub setup { 1; }

sub take_action { 1; }

sub cleanup { 1; }

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};
}

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

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

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,
                         @_);
}

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 overriden 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};
}

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);
}

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 '';
}

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 '';
}

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);
}

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 );
}

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);
}

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

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

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

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

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

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
    );
}

# 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;
}

# 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);
}

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;
}

# 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;
}

# 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);
    }
}

sub _extra_validator_args {
    return {};
}

sub _extra_canonicalizer_args {
    return {};
}

sub _extra_autocompleter_args {
    return {};
}

# 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();
}

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;
}

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;
}

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;
}

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;
}

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;
}

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

    return;

}

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

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

    return;
}

1;