--- trunk/lib/Frey/Action.pm 2009/01/09 21:50:21 976
+++ trunk/lib/Frey/Action.pm 2009/07/05 21:25:25 1171
@@ -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,10 +103,96 @@
=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 ) = @_;
+
+ foreach my $checkbox ( split(/\s+/, $self->params->{'frey-checkboxes'} ) ) {
+ next if defined $self->params->{ $checkbox };
+
+ $self->params->{ $checkbox } = 0;
+ warn "# checkbox $checkbox not ticked";
+ }
+
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;
@@ -124,95 +211,35 @@
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 $html = '';
-
- foreach ( @$values ) {
- my $v = ref($_) eq 'HASH' ? $_->{$name} : $_;
- 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 {
- 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
- }
-
-
- foreach my $checkbox ( split(/\s+/, $default->{'frey-checkboxes'} ) ) {
- next if defined $default->{ $checkbox };
-
- $default->{ $checkbox } = 0;
- $self->params->{ $checkbox } = 0;
- warn "# checkbox $checkbox not ticked";
- }
+ my $form_id = $self->form_id;
my @checkboxes;
my $label_width = 1; # minimum
- foreach my $name (
+ my @fields =
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
- ) {
+ } $self->attributes;
+
+ my $fieldset;
+
+ my $last;
+ foreach my $name ( @fields ) {
+ my $set = $name;
+ $set =~ s{_[^_]+$}{};
+ push @{ $fieldset->{$set} }, $name;
+ }
+
+ delete( $fieldset->{$_} )
+ foreach ( grep { $#{ $fieldset->{$_} } == 0 } keys %$fieldset );
+
+ warn "# fieldset = ",dump( $fieldset );
+
+ foreach my $name ( @fields ) {
my $attr_type = '';
my $type = $name =~ m/^pass/ ? 'password' : 'text';
my $label = $name;
@@ -225,23 +252,30 @@
my $value =
defined $default->{$name} ? $default->{$name} :
$attr->has_default ? $attr->default( $name ) :
- '';
+ undef;
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 = $name . '_available';
+ $available = $class->$available;
+ confess $@ if $@;
+ $available =~ s/^\s+//gs;
+ $available =~ s/\s+$//gs;
+ $value_html = $self->select_values( $name, $attr_type, [ split(/\n/,$available) ]);
} elsif ( $attr_type =~ m{^Bool} ) {
my $suffix = '';
- $suffix = ' checked' if $value;
- $value_html = qq||;
+ $suffix = ' checked=1' if $value;
+ $value_html = qq||;
push @checkboxes, $name;
- } elsif ( ! defined $value ) {
+ } 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||;
}
@@ -254,10 +288,34 @@
# 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{_[^_]+$}{};
+
+ my ( $before, $after ) = ( '', '
' );
+
+ if ( my $s = $fieldset->{$set} ) {
+ if ($s->[0] eq $name) {
+ $before = qq|
+
+ |;
+ }
+ $label =~ s{^\Q$set\E_+}{};
+ }
- $form .= qq|$value_html
|;
+ $label = $self->_label( $label );
+ $form .= qq|$before$value_html $after|;
my $ll = length($label);
$label_width = $ll if $ll > $label_width;
}
@@ -289,10 +347,24 @@
label.required {
font-weight: bold;
}
+ input.required,
+ select.required {
+ border-color: #c00;
+ }
+ input.required-filled,
+ select.required-filled {
+ border-color: #0c0;
+ }
br {
clear: left;
}
+
+ fieldset {
+ margin: 0;
+ padding: 0;
+ margin-bottom: 0.5em;
+ }
|);
my $html;
@@ -300,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 => {
@@ -316,14 +402,30 @@
},
});
+ $self->title( $self->class->title ) if $self->class->title;
+
return ($html,$default) if wantarray;
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;