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 is the superclass for all actions in Jifty. Action classes form the meat of the L framework; they control how form elements interact with the underlying model. See also L for data-oriented actions, L for how to return values from actions. See L for more details on the declarative syntax. See L 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; 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 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 of the action. Defaults to none. =item sticky_on_failure A boolean value that determines if the form fields are L when the action fails. Defaults to true. =item sticky_on_success A boolean value that determines if the form fields are L 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 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: this API is now deprecated in favour of the declarative syntax offered by L. This method, along with L, is the most commonly overridden method. It should return a hash which describes the L 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 object. For each argument, the hash that describes it is used to set up the L 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 be passed to it to execute, these should have the L property set. This is separate from the L 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 calls L, and finally L. If you're writing your own actions, you probably want to override C 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, calls C, canonicalizes and validates each argument that was submitted, but doesn't actually call L. The outcome of all of this is stored on the L 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 is expected to return a true value, or L 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 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 object to store a result). =cut sub take_action { 1; } =head2 cleanup Perform any action-specific cleanup. By default, does nothing. Runs after L -- whether or not L returns success. =cut sub cleanup { 1; } =head2 moniker Returns the L for this action. =head2 argument_value ARGUMENT [VALUE] Returns the value from the argument with the given name, for this action. If I 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 object for this argument. If there is no entry in the L hash that matches the given C, returns C. =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 object that renders a display value instead of an editable widget for this argument. If there is no entry in the L hash that matches the given C, returns C. =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 which should render as a hidden form field, with the default value C. =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 method associated with this action. If an action with the same moniker existed in the B 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 for the definition of "L" actions. Normally, L 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!\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 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( '
' . '' . $self->result->error . '' . '
' ); } return ''; } =head2 button arguments => { KEY => VALUE }, PARAMHASH Create and render a button. It functions nearly identically like L, except it takes C in addition to C, and defaults to submitting this L. Returns nothing. Recommended reading: L, 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, which additionally defaults to calling the current continuation. Takes an additional argument, C, 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 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 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 as its name and a value of 1, and a hidden input with the value of L as its name and a value of 0; using this information, L 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 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 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 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. =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 that this action knows about. This is done by calling L for each field described by L. =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. If the argument has an attribute named B, call the subroutine reference that attribute points points to. If it doesn't have a B attribute, but the action has a C> 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. =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 for each field described by L =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 is mandatory, checks for a value. If the field has an attribute named B, call the subroutine reference validator points to. If the action doesn't have an explicit B attribute, but does have a C> 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. =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. =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. =cut sub _extra_autocompleter_args { return {}; } =head2 _autocomplete_argument ARGUMENT Get back a list of possible completions for C. 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. There can also additionally be a key named C