37 |
my ( $self ) = @_; |
my ( $self ) = @_; |
38 |
$self->load_class( $self->class ); |
$self->load_class( $self->class ); |
39 |
my @required = |
my @required = |
40 |
grep { |
grep { defined $_ } |
|
defined $_ && $_->can('name') && !defined( $self->params->{ $_->name } ) |
|
|
} |
|
41 |
map { |
map { |
42 |
my $attr = $self->class->meta->get_attribute($_); |
eval { |
43 |
$attr->is_required && $attr; |
$_->can('name') && !defined( $self->params->{ $_->name } ) |
44 |
|
}; |
45 |
|
} |
46 |
|
grep { |
47 |
|
my $required = eval { |
48 |
|
my $attr = $self->class->meta->get_attribute($_); |
49 |
|
$attr->is_required; |
50 |
|
}; |
51 |
|
warn "# attribute $_ error: $@" if $@; |
52 |
|
$required; |
53 |
} $self->class->meta->get_attribute_list; |
} $self->class->meta->get_attribute_list; |
54 |
|
|
55 |
warn "## required = ",dump( map { $_->name } @required ), " for ", $self->class if @required && $self->debug; |
warn "## required = ",dump( map { $_->name } @required ), " for ", $self->class if @required && $self->debug; |
89 |
my ( $self ) = @_; |
my ( $self ) = @_; |
90 |
my @required = $self->required; |
my @required = $self->required; |
91 |
if ( ! @required ) { |
if ( ! @required ) { |
92 |
warn "all params available ", dump( $self->params ), " not creating form"; |
warn "all params available ", dump( $self->params ), " not creating form" if $self->debug; |
93 |
return (undef,$self->params) if wantarray; |
return (undef,$self->params) if wantarray; |
94 |
return; |
return; |
95 |
} else { |
} else { |
96 |
warn $self->class, " required params ", dump( @required ) if $self->debug; |
warn $self->class, " required params ", map { $_->dump(2) } @required if $self->debug; |
97 |
} |
} |
98 |
|
|
99 |
my $class = $self->class; |
my $class = $self->class; |
109 |
my $form; |
my $form; |
110 |
|
|
111 |
foreach my $name ( grep { ! $class->meta->get_attribute($_)->is_lazy } $self->attributes ) { |
foreach my $name ( grep { ! $class->meta->get_attribute($_)->is_lazy } $self->attributes ) { |
112 |
my $attr_type; |
my $attr_type = ''; |
113 |
my $type = $name =~ m/^pass/ ? 'password' : 'text'; |
my $type = $name =~ m/^pass/ ? 'password' : 'text'; |
114 |
my $label = $name; |
my $label = $name; |
115 |
my $value = ''; |
my $value = ''; |
126 |
) . qq|</select>|; |
) . qq|</select>|; |
127 |
$default->{$name} = $config_params->[0]->{$name}; |
$default->{$name} = $config_params->[0]->{$name}; |
128 |
} elsif ( my $attr = $class->meta->get_attribute( $name ) ) { |
} elsif ( my $attr = $class->meta->get_attribute( $name ) ) { |
|
$attr_type = $attr->type_constraint->name; |
|
129 |
if ( $attr->has_type_constraint ) { |
if ( $attr->has_type_constraint ) { |
130 |
|
$attr_type = $attr->type_constraint->name; |
131 |
if ( $attr->type_constraint->can('values') ) { |
if ( $attr->type_constraint->can('values') ) { |
132 |
$value_html = qq|<select name="$name">| . join("\n", |
$value_html = qq|<select name="$name">| . join("\n", |
133 |
map { qq|<option value="$_">$_</option>| } @{ $attr->type_constraint->values } |
map { qq|<option value="$_">$_</option>| } @{ $attr->type_constraint->values } |
149 |
# warn "# required $name ", $class->meta->get_attribute( $name )->dump( 2 ); |
# warn "# required $name ", $class->meta->get_attribute( $name )->dump( 2 ); |
150 |
$form .= qq|<label for="$name"$label_title>$label</label>| . $value_html; |
$form .= qq|<label for="$name"$label_title>$label</label>| . $value_html; |
151 |
} |
} |
152 |
my $html = join("\n", |
my $html = qq|<h1>$class params</h1><form method="post">$form<input type="submit" value="Run $class"></form>|; |
153 |
qq|<h1>$class params</h1><form method="post">$form<input type="submit" value="Run $class"></form>|, |
push @{ $self->status }, { 'Params' => |
154 |
qq|<span class="frey-popdown">config<span><code>| . dump( $config_params ) . qq|</span></span>|, |
{ |
155 |
qq|<span class="frey-popdown">default<span><code>| . dump( $default ) . qq|</span></span>|, |
'Config' => $config_params, |
156 |
) if $form; |
'Default' => $default |
157 |
|
}, |
158 |
|
}; |
159 |
|
|
160 |
return ($html,$default) if wantarray; |
return ($html,$default) if wantarray; |
161 |
return $html; |
return $html; |