lib/Frey/Run.pm

package Frey::Run;
use Moose;
#extends 'Frey::ClassLoader';
extends 'Frey::PPI';
with 'Frey::Web';
with 'Frey::Config';
with 'Frey::Escape';

use Data::Dump qw/dump/;
use Frey::Dumper;

=head1 NAME

Frey::Run - display required form field for Class and run it

=head1 DESCRIPTION

This object will try to run other Moose objects from your application. It
will try to invoke C<data>, and C<markup> method on the.

=cut

sub runnable { qw/data markup sponge/ }

has 'class' => (
        is => 'rw',
        isa => 'Str',
        required => 1,
);

has 'params' => (
        is => 'rw',
        isa => 'HashRef',
        default => sub { {} },
);

sub html {
        my ( $self ) = @_;

        my $class = $self->class;

        $self->load_class( $class );

        my @required = 
                grep {
                        defined $_ && $_->can('name') && !defined( $self->params->{ $_->name } )
                }
                map {
                        my $attr = $class->meta->get_attribute($_);
                        $attr->is_required && $attr;
                } $class->meta->get_attribute_list;

        warn "## required = ",dump( map { $_->name } @required ), " for $class";

        my $html;
        my $values = {};
        $values = $self->config($class);
        warn "# $class config = ",dump( $values );

        if ( @required ) {
                $html = qq|<h1>$class params</h1><form method="post">|;

                my $a;
                my @attrs = map {  $a->{$_}++; $_ } $self->attribute_order;
                push @attrs, $_ foreach grep { ! $a->{$_} } map { $_->name } @required;
                warn "# attrs = ",dump( @attrs );

                foreach my $name ( @attrs ) {
                        my $attr = $class->meta->get_attribute( $name );
                        my $type = $name =~ m/^pass/ ? 'password' : 'text';
                        my $value = '';
                        my $value_html = '';
                        if ( ref($values) eq 'HASH' ) {
                                $value = $values->{$name};
                        } elsif ( ref($values) eq 'ARRAY' ) {
                                $value_html = qq|<select name="$name">| . join("\n",
                                        map {
                                                my $v = $_->{$name};
                                                qq|<option value="$v">$v</option>|
                                        } @$values
                                ) . qq|</select>|;
                        } else {
                                $value = $attr->default( $name ) if $attr->has_default;
                        }
                        $value_html = qq|<input type="$type" name="$name" value="$value">| unless $value_html;

#warn "# required $name ", $class->meta->get_attribute( $name )->dump( 2 );
                        $html .= qq|<label for="$name">$name</label>| . $value_html;
                }
                $html .= qq|<input type="submit" value="Run $class"></form>|;
        } else {
                my $o = $class->new( %{ $self->params } );
                $o->depends if $o->can('depends');
                if ( $o->can('markup') ) {
                        warn "## using ",ref($o), "->markup";
                        $html = eval { $o->markup };
                        if ( $@ ) {
                                warn $@;
                                $html .= qq{<code>$@</code>};
                        }
                        warn ">>> markup $class ",length( $html ), " bytes\n";
                } elsif ( $o->can('sponge') ) {
                        my $data = $o->sponge;
                        $html .= '<table>';
                        $html .= '<tr><th>' . join('</th><th>', @{$data->{NAME}} ) . '</th></tr>';
                        $html .= '<tr><td>' . join('</td><td>', @$_ ) . '</td></tr>' foreach @{ $data->{rows} };
                        $html .= '</table>';
                } elsif ( $o->can('data') ) {
                        my $data = $o->data;
                        $html .= Frey::Dumper->new( data => $data )->markup;
                        $html .= '<hr/><code>' . $self->html_dump( $data ) . '</code>';
                } else {
                        $html = "IGNORE: $class ", $o->dump;
                        warn $html;
                }
        }

        return $self->page( title => $class, body => $html );
}

1;
1	dpavlin	180	package Frey::Run;
2			use Moose;
3	dpavlin	331	#extends 'Frey::ClassLoader';
4			extends 'Frey::PPI';
5	dpavlin	180	with 'Frey::Web';
6	dpavlin	222	with 'Frey::Config';
7	dpavlin	225	with 'Frey::Escape';
8	dpavlin	180
9	dpavlin	326	use Data::Dump qw/dump/;
10			use Frey::Dumper;
11
12	dpavlin	180	=head1 NAME
13
14			Frey::Run - display required form field for Class and run it
15
16	dpavlin	206	=head1 DESCRIPTION
17
18			This object will try to run other Moose objects from your application. It
19	dpavlin	314	will try to invoke C<data>, and C<markup> method on the.
20	dpavlin	206
21	dpavlin	180	=cut
22
23	dpavlin	339	sub runnable { qw/data markup sponge/ }
24	dpavlin	223
25	dpavlin	180	has 'class' => (
26			is => 'rw',
27			isa => 'Str',
28			required => 1,
29			);
30
31	dpavlin	277	has 'params' => (
32			is => 'rw',
33			isa => 'HashRef',
34			default => sub { {} },
35			);
36
37			sub html {
38			my ( $self ) = @_;
39	dpavlin	180
40			my $class = $self->class;
41
42	dpavlin	317	$self->load_class( $class );
43
44	dpavlin	180	my @required =
45			grep {
46	dpavlin	285	defined $_ && $_->can('name') && !defined( $self->params->{ $_->name } )
47	dpavlin	180	}
48			map {
49			my $attr = $class->meta->get_attribute($_);
50	dpavlin	285	$attr->is_required && $attr;
51	dpavlin	180	} $class->meta->get_attribute_list;
52
53	dpavlin	285	warn "## required = ",dump( map { $_->name } @required ), " for $class";
54	dpavlin	180
55			my $html;
56	dpavlin	277	my $values = {};
57	dpavlin	324	$values = $self->config($class);
58			warn "# $class config = ",dump( $values );
59	dpavlin	180
60			if ( @required ) {
61	dpavlin	331	$html = qq\|<h1>$class params</h1><form method="post">\|;
62	dpavlin	336
63			my $a;
64			my @attrs = map { $a->{$_}++; $_ } $self->attribute_order;
65			push @attrs, $_ foreach grep { ! $a->{$_} } map { $_->name } @required;
66			warn "# attrs = ",dump( @attrs );
67
68			foreach my $name ( @attrs ) {
69	dpavlin	331	my $attr = $class->meta->get_attribute( $name );
70	dpavlin	222	my $type = $name =~ m/^pass/ ? 'password' : 'text';
71	dpavlin	348	my $value = '';
72			my $value_html = '';
73			if ( ref($values) eq 'HASH' ) {
74			$value = $values->{$name};
75			} elsif ( ref($values) eq 'ARRAY' ) {
76			$value_html = qq\|<select name="$name">\| . join("\n",
77			map {
78			my $v = $_->{$name};
79			qq\|<option value="$v">$v</option>\|
80			} @$values
81			) . qq\|</select>\|;
82			} else {
83			$value = $attr->default( $name ) if $attr->has_default;
84			}
85			$value_html = qq\|<input type="$type" name="$name" value="$value">\| unless $value_html;
86
87	dpavlin	285	#warn "# required $name ", $class->meta->get_attribute( $name )->dump( 2 );
88	dpavlin	348	$html .= qq\|<label for="$name">$name</label>\| . $value_html;
89	dpavlin	222	}
90	dpavlin	180	$html .= qq\|<input type="submit" value="Run $class"></form>\|;
91			} else {
92	dpavlin	277	my $o = $class->new( %{ $self->params } );
93	dpavlin	180	$o->depends if $o->can('depends');
94	dpavlin	277	if ( $o->can('markup') ) {
95	dpavlin	229	warn "## using ",ref($o), "->markup";
96	dpavlin	277	$html = eval { $o->markup };
97			if ( $@ ) {
98			warn $@;
99			$html .= qq{<code>$@</code>};
100			}
101	dpavlin	195	warn ">>> markup $class ",length( $html ), " bytes\n";
102	dpavlin	339	} elsif ( $o->can('sponge') ) {
103			my $data = $o->sponge;
104			$html .= '<table>';
105			$html .= '<tr><th>' . join('</th><th>', @{$data->{NAME}} ) . '</th></tr>';
106			$html .= '<tr><td>' . join('</td><td>', @$_ ) . '</td></tr>' foreach @{ $data->{rows} };
107			$html .= '</table>';
108	dpavlin	223	} elsif ( $o->can('data') ) {
109	dpavlin	326	my $data = $o->data;
110			$html .= Frey::Dumper->new( data => $data )->markup;
111	dpavlin	327	$html .= '<hr/><code>' . $self->html_dump( $data ) . '</code>';
112	dpavlin	204	} else {
113			$html = "IGNORE: $class ", $o->dump;
114			warn $html;
115	dpavlin	184	}
116	dpavlin	180	}
117
118	dpavlin	277	return $self->page( title => $class, body => $html );
119	dpavlin	180	}
120
121			1;