use strict; package HTML::FormFu::Role::Element::Field; $HTML::FormFu::Role::Element::Field::VERSION = '2.07'; # ABSTRACT: Role for all form-field elements use Moose::Role; use MooseX::Aliases; with 'HTML::FormFu::Role::ContainsElementsSharedWithField', 'HTML::FormFu::Role::NestedHashUtils', 'HTML::FormFu::Role::FormBlockAndFieldMethods', 'HTML::FormFu::Role::Element::Layout'; use HTML::FormFu::Attribute qw( mk_attrs mk_output_accessors ); use HTML::FormFu::Constants qw( $EMPTY_STR ); use HTML::FormFu::Util qw( _parse_args append_xml_attribute xml_escape require_class process_attrs _filter_components ); use Class::MOP::Method; use Clone (); use List::Util 1.45 qw( uniq ); use Carp qw( croak carp ); __PACKAGE__->mk_attrs( qw( comment_attributes container_attributes label_attributes error_attributes error_container_attributes ) ); has _constraints => ( is => 'rw', traits => ['Chained'] ); has _filters => ( is => 'rw', traits => ['Chained'] ); has _inflators => ( is => 'rw', traits => ['Chained'] ); has _deflators => ( is => 'rw', traits => ['Chained'] ); has _validators => ( is => 'rw', traits => ['Chained'] ); has _transformers => ( is => 'rw', traits => ['Chained'] ); has _plugins => ( is => 'rw', traits => ['Chained'] ); has _errors => ( is => 'rw', traits => ['Chained'] ); has container_tag => ( is => 'rw', traits => ['Chained'] ); has field_filename => ( is => 'rw', traits => ['Chained'] ); has label_filename => ( is => 'rw', traits => ['Chained'] ); has label_tag => ( is => 'rw', traits => ['Chained'] ); has retain_default => ( is => 'rw', traits => ['Chained'] ); has force_default => ( is => 'rw', traits => ['Chained'] ); has javascript => ( is => 'rw', traits => ['Chained'] ); has non_param => ( is => 'rw', traits => ['Chained'] ); has reverse_single => ( is => 'rw', traits => ['Chained'] ); has reverse_multi => ( is => 'rw', traits => ['Chained'] ); has multi_value => ( is => 'rw', traits => ['Chained'] ); has original_name => ( is => 'rw', traits => ['Chained'] ); has original_nested_name => ( is => 'rw', traits => ['Chained'] ); has default_empty_value => ( is => 'rw', traits => ['Chained'] ); __PACKAGE__->mk_output_accessors(qw( comment label value )); alias( "default", "value" ); alias( "default_xml", "value_xml" ); alias( "default_loc", "value_loc" ); after BUILD => sub { my $self = shift; $self->_constraints( [] ); $self->_filters( [] ); $self->_deflators( [] ); $self->_inflators( [] ); $self->_validators( [] ); $self->_transformers( [] ); $self->_plugins( [] ); $self->_errors( [] ); $self->comment_attributes( {} ); $self->container_attributes( {} ); $self->label_attributes( {} ); $self->error_attributes( {} ); $self->error_container_attributes( {} ); $self->label_filename('label'); $self->label_tag('label'); $self->container_tag('div'); $self->is_field(1); return; }; sub nested { my ($self) = @_; croak 'cannot set nested' if @_ > 1; if ( defined $self->name ) { my $parent = $self; while ( defined( $parent = $parent->parent ) ) { if ( $parent->can('is_field') && $parent->is_field ) { return 1 if defined $parent->name; } else { return 1 if defined $parent->nested_name; } } } return; } sub nested_name { my ($self) = @_; croak 'cannot set nested_name' if @_ > 1; return if !defined $self->name; my @names = $self->nested_names; if ( $self->form->nested_subscript ) { my $name = shift @names; map { $name .= "[$_]" } @names; # TODO - Mario Minati 19.05.2009 # Does this (name formatted as '[name]') collide with FF::Model::HashRef as # it uses /_\d/ to parse repeatable names? return $name; } else { return join ".", @names; } } sub nested_names { my ($self) = @_; croak 'cannot set nested_names' if @_ > 1; if ( defined( my $name = $self->name ) ) { my @names; my $parent = $self; # micro optimization! this method's called a lot, so access # parent hashkey directly, instead of calling parent() while ( defined( $parent = $parent->{parent} ) ) { if ( $parent->can('is_field') && $parent->is_field ) { # handling Field push @names, $parent->name if defined $parent->name; } elsif ( $parent->can('is_repeatable') && $parent->is_repeatable ) { # handling Repeatable # ignore Repeatables nested_name attribute as it is provided # by the childrens Block elements } else { # handling 'not Field' and 'not Repeatable' push @names, $parent->nested_name if defined $parent->nested_name; } } if (@names) { return reverse $name, @names; } } return ( $self->name ); } sub build_original_nested_name { my ($self) = @_; croak 'cannot set build_original_nested_name' if @_ > 1; return if !defined $self->name; my @names = $self->build_original_nested_names; if ( $self->form->nested_subscript ) { my $name = shift @names; map { $name .= "[$_]" } @names; # TODO - Mario Minati 19.05.2009 # Does this (name formatted as '[name]') collide with FF::Model::HashRef as # it uses /_\d/ to parse repeatable names? return $name; } else { return join ".", @names; } } sub build_original_nested_names { my ($self) = @_; croak 'cannot set build_original_nested_names' if @_ > 1; # TODO - Mario Minati 19.05.2009 # Maybe we have to use original_name instead of name. # Yet there is no testcase, which is currently failing. if ( defined( my $name = $self->name ) ) { my @names; my $parent = $self; # micro optimization! this method's called a lot, so access # parent hashkey directly, instead of calling parent() while ( defined( $parent = $parent->{parent} ) ) { if ( $parent->can('is_field') && $parent->is_field ) { # handling Field if ( defined $parent->original_name ) { push @names, $parent->original_name; } elsif ( defined $parent->name ) { push @names, $parent->name; } } elsif ( $parent->can('is_repeatable') && $parent->is_repeatable ) { # handling Repeatable # TODO - Mario Minati 19.05.2009 # Do we have to take care of chains of Repeatable elements, if the Block # elements have already been created for the outer Repeatable elements to # avoid 'outer.outer_1.inner' # Yet there is no failing testcase. All testcases in FF and FF::Model::DBIC # which have nested repeatable elements are passing currently. push @names, $parent->original_nested_name if defined $parent->original_nested_name; } else { # handling 'not Field' and 'not Repeatable' if ( $parent->can('original_nested_name') && defined $parent->original_nested_name ) { push @names, $parent->original_nested_name; } elsif ( defined $parent->nested_name ) { push @names, $parent->nested_name; } } } if (@names) { return reverse $name, @names; } } return ( $self->name ); } sub nested_base { my ($self) = @_; croak 'cannot set nested_base' if @_ > 1; my $parent = $self; while ( defined( $parent = $parent->parent ) ) { return $parent->nested_name if defined $parent->nested_name; } } sub get_deflators { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_deflators }; return _filter_components( \%args, \@x ); } sub get_filters { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_filters }; return _filter_components( \%args, \@x ); } sub get_constraints { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_constraints }; return _filter_components( \%args, \@x ); } sub get_inflators { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_inflators }; return _filter_components( \%args, \@x ); } sub get_validators { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_validators }; return _filter_components( \%args, \@x ); } sub get_transformers { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_transformers }; return _filter_components( \%args, \@x ); } sub get_errors { my $self = shift; my %args = _parse_args(@_); my @x = @{ $self->_errors }; _filter_components( \%args, \@x ); if ( !$args{forced} ) { @x = grep { !$_->forced } @x; } return \@x; } sub clear_errors { my ($self) = @_; $self->_errors( [] ); return; } after pre_process => sub { my $self = shift; for my $plugin ( @{ $self->_plugins } ) { $plugin->pre_process; } return; }; after process => sub { my $self = shift; for my $plugin ( @{ $self->_plugins } ) { $plugin->process; } return; }; after post_process => sub { my $self = shift; for my $plugin ( @{ $self->_plugins } ) { $plugin->post_process; } return; }; sub process_input { my ( $self, $input ) = @_; my $submitted = $self->form->submitted; my $default = $self->default; my $original = $self->value; my $name = $self->nested_name; # set input to default value (defined before calling FormFu->process) if ( $submitted && $self->force_default && defined $default ) { $self->set_nested_hash_value( $input, $name, $default ); } # checkbox, radio elsif ($submitted && $self->force_default && $self->can('checked') && $self->checked ) { # the checked attribute is set, so force input to be the original value $self->set_nested_hash_value( $input, $name, $original ); } # checkbox, radio elsif ($submitted && $self->force_default && !defined $default && defined $original ) { # default and value are not equal, so this element is not checked by default $self->set_nested_hash_value( $input, $name, undef ); } return; } sub prepare_id { my ( $self, $render ) = @_; if ( !defined $render->{attributes}{id} && defined $self->auto_id && length $self->auto_id ) { my $form_name = defined $self->form->id ? $self->form->id : $EMPTY_STR; my $field_name = defined $render->{nested_name} ? $render->{nested_name} : $EMPTY_STR; my %string = ( f => $form_name, n => $field_name, ); my $id = $self->auto_id; $id =~ s/%([fn])/$string{$1}/g; if ( defined( my $count = $self->repeatable_count ) ) { $id =~ s/%r/$count/g; } $render->{attributes}{id} = $id; } return; } sub process_value { my ( $self, $value ) = @_; my $submitted = $self->form->submitted; my $default = $self->default; my $new; if ($submitted) { if ( defined $value ) { $new = $value; } elsif ( defined $default ) { $new = $EMPTY_STR; } } else { $new = $default; } if ( $submitted && $self->retain_default && defined $new && $new eq $EMPTY_STR ) { $new = $default; } # if the default value has been changed after FormFu->process has been # called we use it and set the value to that changed default again if ( $submitted && $self->force_default && defined $default && $new ne $default ) { $new = $default; } return $new; } around render_data_non_recursive => sub { my ( $orig, $self, $args ) = @_; my $render = $self->$orig( { nested_name => xml_escape( $self->nested_name ), comment_attributes => xml_escape( $self->comment_attributes ), container_attributes => xml_escape( $self->container_attributes ), error_container_attributes => xml_escape( $self->error_container_attributes ), label_attributes => xml_escape( $self->label_attributes ), comment => xml_escape( $self->comment ), label => xml_escape( $self->label ), field_filename => $self->field_filename, label_filename => $self->label_filename, label_tag => $self->label_tag, container_tag => $self->container_tag, error_container_tag => $self->error_container_tag, error_tag => $self->error_tag, reverse_single => $self->reverse_single, reverse_multi => $self->reverse_multi, javascript => $self->javascript, $args ? %$args : (), } ); $self->_render_container_class($render); $self->_render_comment_class($render); $self->_render_label($render); $self->_render_value($render); $self->_render_constraint_class($render); $self->_render_inflator_class($render); $self->_render_validator_class($render); $self->_render_transformer_class($render); $self->_render_error_class($render); return $render; }; sub _render_label { my ( $self, $render ) = @_; if ( !defined $render->{label} && defined $self->auto_label && length $self->auto_label ) { my %string = ( f => defined $self->form->id ? $self->form->id : '', n => defined $render->{name} ? $render->{name} : '', ); my $label = $self->auto_label; $label =~ s/%([fn])/$string{$1}/g; $render->{label} = $self->form->localize($label); } if ( defined $render->{label} && defined $self->auto_label_class && length $self->auto_label_class ) { my $form_name = defined $self->form->id ? $self->form->id : $EMPTY_STR; my $field_name = defined $render->{nested_name} ? $render->{nested_name} : $EMPTY_STR; my $type = lc $self->type; $type =~ s/:://g; my %string = ( f => $form_name, n => $field_name, t => $type, ); my $class = $self->auto_label_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{label_attributes}, 'class', $class ); } if ( defined $render->{label} && defined $self->auto_container_label_class && length $self->auto_container_label_class ) { my $form_name = defined $self->form->id ? $self->form->id : $EMPTY_STR; my $field_name = defined $render->{nested_name} ? $render->{nested_name} : $EMPTY_STR; my $type = lc $self->type; $type =~ s/:://g; my %string = ( f => $form_name, n => $field_name, t => $type, ); my $class = $self->auto_container_label_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class ); } # label "for" attribute if ( defined $render->{label} && defined $render->{attributes}{id} && !exists $render->{label_attributes}{for} ) { $render->{label_attributes}{for} = $render->{attributes}{id}; } return; } sub _render_comment_class { my ( $self, $render ) = @_; if ( defined $render->{comment} && defined $self->auto_comment_class && length $self->auto_comment_class ) { my $form_name = defined $self->form->id ? $self->form->id : $EMPTY_STR; my $field_name = defined $render->{nested_name} ? $render->{nested_name} : $EMPTY_STR; my %string = ( f => $form_name, n => $field_name, ); my $class = $self->auto_comment_class; $class =~ s/%([fn])/$string{$1}/g; append_xml_attribute( $render->{comment_attributes}, 'class', $class ); } if ( defined $render->{comment} && defined $self->auto_container_comment_class && length $self->auto_container_comment_class ) { my $form_name = defined $self->form->id ? $self->form->id : $EMPTY_STR; my $field_name = defined $render->{nested_name} ? $render->{nested_name} : $EMPTY_STR; my %string = ( f => $form_name, n => $field_name, ); my $class = $self->auto_container_comment_class; $class =~ s/%([fn])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class ); } return; } sub _render_value { my ( $self, $render ) = @_; my $form = $self->form; my $name = $self->nested_name; my $input; if ( $self->form->submitted && defined $name && $self->nested_hash_key_exists( $form->input, $name ) ) { if ( $self->render_processed_value ) { $input = $self->get_nested_hash_value( $form->_processed_params, $name, ); } else { $input = $self->get_nested_hash_value( $form->input, $name, ); } } if ( ref $input eq 'ARRAY' ) { my $elems = $self->form->get_fields( $self->name ); for ( 0 .. @$elems - 1 ) { if ( $self == $elems->[$_] ) { $input = $input->[$_]; } } } my $value = $self->process_value($input); if ( !$self->form->submitted || ( $self->render_processed_value && defined $value ) ) { for my $deflator ( @{ $self->_deflators } ) { $value = $deflator->process($value); } } # handle multiple values for the same name if ( ref $value eq 'ARRAY' && defined $self->name ) { my $max = $#$value; my $fields = $self->form->get_fields( name => $self->name ); for my $i ( 0 .. $max ) { if ( defined $fields->[$i] && $fields->[$i] eq $self ) { $value = $value->[$i]; last; } } } $render->{value} = xml_escape($value); return; } sub _render_container_class { my ( $self, $render ) = @_; if ( defined $self->auto_container_class && length $self->auto_container_class ) { my $form_name = defined $self->form->id ? $self->form->id : $EMPTY_STR; my $field_name = defined $render->{nested_name} ? $render->{nested_name} : $EMPTY_STR; my $type = lc $self->type; $type =~ s/:://g; my %string = ( f => $form_name, n => $field_name, t => $type, ); my $class = $self->auto_container_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class ); } return; } sub _render_constraint_class { my ( $self, $render ) = @_; my $auto_class = $self->auto_constraint_class; return if !defined $auto_class; for my $c ( @{ $self->_constraints } ) { my %string = ( f => defined $self->form->id ? $self->form->id : '', n => defined $render->{name} ? $render->{name} : '', t => defined $c->type ? lc( $c->type ) : '', ); $string{t} =~ s/::/_/g; $string{t} =~ s/\+//; my $class = $auto_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class, ); } return; } sub _render_inflator_class { my ( $self, $render ) = @_; my $auto_class = $self->auto_inflator_class; return if !defined $auto_class; for my $c ( @{ $self->_inflators } ) { my %string = ( f => defined $self->form->id ? $self->form->id : '', n => defined $render->{name} ? $render->{name} : '', t => defined $c->type ? lc( $c->type ) : '', ); $string{t} =~ s/::/_/g; $string{t} =~ s/\+//; my $class = $auto_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class, ); } return; } sub _render_validator_class { my ( $self, $render ) = @_; my $auto_class = $self->auto_validator_class; return if !defined $auto_class; for my $c ( @{ $self->_validators } ) { my %string = ( f => defined $self->form->id ? $self->form->id : '', n => defined $render->{name} ? $render->{name} : '', t => defined $c->type ? lc( $c->type ) : '', ); $string{t} =~ s/::/_/g; $string{t} =~ s/\+//; my $class = $auto_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class, ); } return; } sub _render_transformer_class { my ( $self, $render ) = @_; my $auto_class = $self->auto_transformer_class; return if !defined $auto_class; for my $c ( @{ $self->_transformers } ) { my %string = ( f => defined $self->form->id ? $self->form->id : '', n => defined $render->{name} ? $render->{name} : '', t => defined $c->type ? lc( $c->type ) : '', ); $string{t} =~ s/::/_/g; $string{t} =~ s/\+//; my $class = $auto_class; $class =~ s/%([fnt])/$string{$1}/g; append_xml_attribute( $render->{container_attributes}, 'class', $class, ); } return; } sub _render_error_class { my ( $self, $render ) = @_; my @errors = @{ $self->get_errors( { forced => 1 } ) }; return if !@errors; @errors = map { $_->render_data } @errors; $render->{errors} = \@errors; # auto_error_field_class my $field_class = $self->auto_error_field_class; if ( defined $field_class && length $field_class ) { my %string = ( f => sub { defined $self->form->id ? $self->form->id : '' }, n => sub { defined $render->{name} ? $render->{name} : '' }, ); $field_class =~ s/%([fn])/$string{$1}->()/ge; append_xml_attribute( $render->{attributes}, 'class', $field_class ); } my @container_class; # auto_container_error_class my $auto_class = $self->auto_container_error_class; if ( defined $auto_class && length $auto_class ) { my %string = ( f => sub { defined $self->form->id ? $self->form->id : '' }, n => sub { defined $render->{name} ? $render->{name} : '' }, ); $auto_class =~ s/%([fn])/$string{$1}->()/ge; push @container_class, $auto_class; } # auto_container_per_error_class my $item_class = $self->auto_container_per_error_class; if ( defined $item_class && length $item_class ) { for my $error (@errors) { my %string = ( f => sub { defined $self->form->id ? $self->form->id : '' }, n => sub { defined $render->{name} ? $render->{name} : '' }, s => sub { $error->{stage} }, t => sub { lc $error->{type} }, ); my $string = $item_class; $string =~ s/%([fnst])/$string{$1}->()/ge; push @container_class, $string; } } map { append_xml_attribute( $render->{container_attributes}, 'class', $_ ) } uniq @container_class; my @error_container_class; if ( $self->error_container_tag ) { # auto_error_container_class my $auto_class = $self->auto_error_container_class; if ( defined $auto_class && length $auto_class ) { my %string = ( f => sub { defined $self->form->id ? $self->form->id : '' }, n => sub { defined $render->{name} ? $render->{name} : '' }, ); $auto_class =~ s/%([fn])/$string{$1}->()/ge; push @error_container_class, $auto_class; } # auto_container_per_error_class my $item_class = $self->auto_container_per_error_class; if ( defined $item_class && length $item_class ) { for my $error (@errors) { my %string = ( f => sub { defined $self->form->id ? $self->form->id : '' }, n => sub { defined $render->{name} ? $render->{name} : '' }, s => sub { $error->{stage} }, t => sub { lc $error->{type} }, ); my $string = $item_class; $string =~ s/%([fnst])/$string{$1}->()/ge; push @error_container_class, $string; } } map { append_xml_attribute( $render->{error_container_attributes}, 'class', $_ ) } uniq @error_container_class; } return; } sub render_label { my ($self) = @_; my $render = $self->render_data; return $self->_string_label($render); } sub render_field { my ($self) = @_; my $render = $self->render_data; return $self->_string_field($render); } sub _string_field_start { my ( $self, $render ) = @_; # field wrapper template - start my $html = ''; if ( defined $render->{container_tag} ) { $html .= sprintf '<%s%s>', $render->{container_tag}, process_attrs( $render->{container_attributes} ); } if ( defined $render->{label} && $render->{label_tag} eq 'legend' ) { $html .= sprintf "\n%s", $self->_string_label($render); } $html .= $self->_string_errors($render); if ( defined $render->{label} && $render->{label_tag} ne 'legend' && !$render->{reverse_single} ) { $html .= sprintf "\n%s", $self->_string_label($render); } if ( defined $render->{container_tag} ) { $html .= "\n"; } return $html; } sub _string_label { my ( $self, $render ) = @_; # label template my $html = sprintf "<%s%s>%s", $render->{label_tag}, process_attrs( $render->{label_attributes} ), $render->{label}, $render->{label_tag}, ; return $html; } sub _string_errors { my ( $self, $render ) = @_; return '' if !$render->{errors}; my $html = ''; if ( $render->{error_container_tag} ) { $html .= sprintf qq{<%s%s>\n}, $render->{error_container_tag}, process_attrs( $render->{error_container_attributes} ), ; } my @error_html; for my $error ( @{ $render->{errors} } ) { push @error_html, sprintf qq{<%s%s>%s}, $render->{error_tag}, process_attrs( $error->{attributes} ), $error->{message}, $render->{error_tag}, ; } $html .= join "\n", @error_html; if ( $render->{error_container_tag} ) { $html .= sprintf qq{\n}, $render->{error_container_tag}; } return $html; } sub _string_field_end { my ( $self, $render ) = @_; # field wrapper template - end my $html = ''; if ( defined $render->{label} && $render->{label_tag} ne 'legend' && $render->{reverse_single} ) { $html .= sprintf "\n%s", $self->_string_label($render); } if ( defined $render->{comment} ) { $html .= sprintf "\n\n%s\n", process_attrs( $render->{comment_attributes} ), $render->{comment}, ; } if ( defined $render->{container_tag} ) { $html .= sprintf "\n", $render->{container_tag},; } if ( defined $render->{javascript} ) { $html .= sprintf qq{\n}, $render->{javascript}, ; } return $html; } around clone => sub { my $orig = shift; my $self = shift; my $clone = $self->$orig(@_); for my $list ( qw( _filters _constraints _inflators _validators _transformers _deflators _errors _plugins ) ) { $clone->$list( [ map { $_->clone } @{ $self->$list } ] ); map { $_->parent($clone) } @{ $clone->$list }; } $clone->comment_attributes( Clone::clone( $self->comment_attributes ) ); $clone->container_attributes( Clone::clone( $self->container_attributes ) ); $clone->label_attributes( Clone::clone( $self->label_attributes ) ); return $clone; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::FormFu::Role::Element::Field - Role for all form-field elements =head1 VERSION version 2.07 =head1 DESCRIPTION Base-class for all form-field elements. =head1 METHODS =head2 default Set the form-field's default value. Is an L. =head2 value For most fields, L is an alias for L. For the L and L elements, L sets what the value of the field will be if it is checked or selected. If the L is the same as the L, then the field will be checked or selected when rendered. For the L and L elements, the L is ignored: L or L provides the equivalent function. Is an L. =head2 non_param Arguments: bool Default Value: false If true, values for this field are never returned by L, L and L. This is useful for Submit buttons, when you only use its value as an L =head2 placeholder Sets the HTML5 attribute C to the specified value. Is an L. =head2 javascript Arguments: [$javascript] If set, the contents will be rendered within a C