--- 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
-
- | 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|
+
+ |;
+ $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;