--- trunk/lib/Frey/Action.pm 2009/06/28 23:08:02 1101 +++ trunk/lib/Frey/Action.pm 2009/07/02 17:59:56 1164 @@ -1,8 +1,7 @@ package Frey::Action; use Moose; extends 'Frey::PPI'; -with 'Frey::Web'; -with 'Frey::Config'; +with 'Frey::Web', 'Frey::Config'; use Clone qw/clone/; use Data::Dump qw/dump/; @@ -54,7 +53,6 @@ my @required = grep { defined $_ && $_->can('name') && - ! defined( $self->params->{ $_->name } ) && ! $_->is_lazy } map { @@ -67,7 +65,10 @@ if ( $param eq 'as_hash' ) { my $hash; - map { $hash->{$_}++ } @required; + map { + $hash->{$_} = 1; + $hash->{$_} = 0 if defined $self->params->{$_}; + } @required; return $hash; } return @required if wantarray; @@ -102,6 +103,84 @@ =cut +sub form_id { + my ($self) = @_; + my $form_id = $self->class; + $form_id =~ s{\W+}{_}g; + return $form_id; +} + +sub select_values { + my ( $self, $name, $attr_type, $values ) = @_; + + $attr_type ||= '?' and warn "$name doesn't have attr_type"; + + my $form_id = $self->form_id; + my $max_value_len = 0; + my @values; + my $display; + my $html = ''; + + foreach ( @$values ) { + my $v = ref($_) eq 'HASH' ? $_->{$name} : $_; + if ( $v =~ s/\t+(.+)$// ) { + $display->{$v} = $1; + } + warn "## value '$v'"; + push @values, $v; + $max_value_len = length($v) if length($v) > $max_value_len; + } + + warn "# max_value_len: $max_value_len"; + #my $render = eval $class . '->render_' . $name; + my $call = 'render_' . $name; + my $render = $self->class->$call if $self->class->can($call); + warn "## render $@"; + + if ( $#values > 3 && $render !~ m{radio} ) { + my $options = join("\n", + map { + my $d = $display->{$_} || $_; + qq||; + } @values + ); + # onchange="alert(this.options[this.selectedIndex].value);" + $html = qq| + + | if $options; + } else { + my $delimiter = $max_value_len > $self->input_step_size ? qq|
| : ''; + my $radio = +# $delimiter . + join("\n", + map { strip(qq| + + + $_ + + $delimiter + |) } @values + ); + if ( $radio ) { + + my $size = int( $max_value_len / $self->input_step_size ) + 1; + $size = 5 if $size > 5; + $size *= $self->input_step_size; + $radio .= qq| + + + + + |; + } + $html = qq|
$radio
|; + } + + return $html; +} + sub params_form { my ( $self ) = @_; @@ -113,7 +192,7 @@ } my $required = $self->required('as_hash'); - if ( $required ) { + if ( grep { $required->{$_} } keys %$required ) { warn $self->class, " required params ", dump( keys %$required ) if $self->debug; } else { warn "all params available ", dump( $self->params ), " not creating form" if $self->debug; @@ -132,79 +211,7 @@ warn "# $class config = ",dump( $params_config ) if $self->debug; my $form; - my $form_id = $class; - $form_id =~ s{\W+}{_}g; - - sub select_values { - my ( $name, $attr_type, $values ) = @_; - - $attr_type ||= '?' and warn "$name doesn't have attr_type"; - - my $max_value_len = 0; - my @values; - my $display; - my $html = ''; - - foreach ( @$values ) { - my $v = ref($_) eq 'HASH' ? $_->{$name} : $_; - if ( $v =~ s/\t+(.+)$// ) { - $display->{$v} = $1; - } - warn "## value '$v'"; - push @values, $v; - $max_value_len = length($v) if length($v) > $max_value_len; - } - - warn "# max_value_len: $max_value_len"; - my $render = eval $class . '->render_' . $name; - warn "## render $@"; - - if ( $#values > 3 && $render !~ m{radio} ) { - my $options = join("\n", - map { - my $d = $display->{$_} || $_; - qq||; - } @values - ); - # onchange="alert(this.options[this.selectedIndex].value);" - $html = qq| - - | if $options; - } else { - my $delimiter = $max_value_len > $self->input_step_size ? qq|
| : ''; - my $radio = -# $delimiter . - join("\n", - map { strip(qq| - - - $_ - - $delimiter - |) } @values - ); - if ( $radio ) { - - my $size = int( $max_value_len / $self->input_step_size ) + 1; - $size = 5 if $size > 5; - $size *= $self->input_step_size; - $radio .= qq| - - - - - |; - } - $html = qq|
$radio
|; - } - - return -# qq|| . - $html - } - + my $form_id = $self->form_id; my @checkboxes; @@ -214,7 +221,7 @@ grep { die "$_ doesn't have meta" unless $class->can('meta'); ! $class->meta->get_attribute($_)->is_lazy - && ! defined $default->{$_} +# && ! defined $default->{$_} # XXX show fields with values && ! m{^_} # skip _private } $self->attributes; @@ -230,8 +237,7 @@ delete( $fieldset->{$_} ) foreach ( grep { $#{ $fieldset->{$_} } == 0 } keys %$fieldset ); -warn "XXX fields = ",dump( @fields ); -warn "XXX set = ",dump( $fieldset ); + warn "# fieldset = ",dump( $fieldset ); foreach my $name ( @fields ) { my $attr_type = ''; @@ -251,16 +257,17 @@ if ( ref($params_config) eq 'HASH' && defined $params_config->{$name} ) { $value = $params_config->{$name}; } elsif ( ref($params_config) eq 'ARRAY' ) { - $value_html = select_values( $name, $attr_type, $params_config ); + $value_html = $self->select_values( $name, $attr_type, $params_config ); $default->{$name} = $params_config->[0]->{$name}; } elsif ( $attr->has_type_constraint && $attr->type_constraint->can('values') ) { - $value_html = select_values( $name, $attr_type, $attr->type_constraint->values ); + $value_html = $self->select_values( $name, $attr_type, $attr->type_constraint->values ); } elsif ( $class->can( $name . '_available' ) ) { - my $available = eval $class . '->' . $name . '_available'; + my $available = $name . '_available'; + $available = $class->$available; confess $@ if $@; $available =~ s/^\s+//gs; $available =~ s/\s+$//gs; - $value_html = select_values( $name, $attr_type, [ split(/\n/,$available) ]); + $value_html = $self->select_values( $name, $attr_type, [ split(/\n/,$available) ]); } elsif ( $attr_type =~ m{^Bool} ) { my $suffix = ''; $suffix = ' checked=1' if $value; @@ -268,7 +275,7 @@ push @checkboxes, $name; } elsif ( ! defined $value && ! $required->{$name} ) { $value_html = qq|undef|; # FIXME if $self->debug - } elsif ( $attr_type !~ m{^(Str|Int)$} || $value =~ $Frey::Web::re_html || $name =~ m{text} ) { + } elsif ( $attr_type !~ m{^(Str|Int|Email)$} || $value =~ $Frey::Web::re_html || $name =~ m{text} ) { $value_html = qq||; } @@ -281,8 +288,12 @@ # warn "# required $name ", $class->meta->get_attribute( $name )->dump( 2 ); - $label_title .= qq| class="required"| if $required->{$name}; - $label =~ s/_/ /g; + if ( defined $required->{$name} ) { + $label_title .= qq| class="required"|; + my $class = 'required'; + $class = 'required-filled' if ! $required->{$name}; + $value_html =~ s{(<\S+)\s}{$1 class=$class }; + } my $set = $name; $set =~ s{_[^_]+$}{}; @@ -300,9 +311,10 @@ |; } - $label =~ s{^\Q$set\E\s+}{}; + $label =~ s{^\Q$set\E_+}{}; } + $label = $self->_label( $label ); $form .= qq|$before$value_html $after|; my $ll = length($label); $label_width = $ll if $ll > $label_width; @@ -335,6 +347,14 @@ label.required { font-weight: bold; } + input.required, + select.required { + border-color: #c00; + } + input.required-filled, + select.required-filled { + border-color: #0c0; + } br { clear: left; @@ -343,6 +363,7 @@ fieldset { margin: 0; padding: 0; + margin-bottom: 0.5em; } |); @@ -351,13 +372,27 @@ # http://www.quirksmode.org/oddsandends/forms.html # $form =~ s{<([^>]+)(name=")([^"]+)(")([^>]*)>}{<$1$2$3$4 id="$3" $5}gs; - $html = qq| -

$class params

-
- $form - -
- | if $form; + if ( $form ) { + + if ( $self->class->can('form_header') ) { + $html = $self->class->form_header; + } else { + $html = qq| +

$class params

+ |; + } + + my $submit = $self->_label( 'submit' ); + $submit =~ s{^submit$}{Run $class}; + + $html .= qq| +
+ $form + +
+ |; + $html .= $self->class->form_footer if $self->class->can('form_footer'); + } $self->add_status({ $self->class => { @@ -371,10 +406,24 @@ return $html; } +sub _label { + my ($self,$name) = @_; + my $labels = $self->class->form_labels if $self->class->can('form_labels'); + my $label = $labels->{$name}; + if ( ! defined $label ) { + $label = $name; + $label =~ s{_}{ }g; + } + return $label; +} + =head1 SEE ALSO L for info on CSS2 forms =cut +__PACKAGE__->meta->make_immutable; +no Moose; + 1;