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

use Moose::Util::TypeConstraints;

enum 'Runnable' => qw/data markup sponge/;

sub runnable { qw/data markup sponge/ }

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

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

has 'run' => (
        is => 'rw',
        isa => 'Runnable',
        default => 'markup',
);

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>|;
                        } elsif ( $attr->has_type_constraint && $attr->type_constraint->can('values') ) {
                                $value_html = qq|<select name="$name">| . join("\n",
                                        map { qq|<option value="$_">$_</option>| } @{ $attr->type_constraint->values }
                                ) . qq|</select>|;
                        } elsif ( $attr->has_default ) {
                                $value = $attr->default( $name );
                        }
                        $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 {
                eval {
                        my $o;
                        $o = $class->new( %{ $self->params } );
                        $o->depends if $o->can('depends');

                        if ( $self->run eq 'markup' ) {
                                warn "## using ",ref($o), "->markup";
                                $html = $o->markup;
                                warn ">>> markup $class ",length( $html ), " bytes\n";
                        } elsif ( $self->run eq 'sponge' ) {
                                my $data = $o->sponge;
                                confess "invalid data from sponge = ", dump( $data ) unless ref($data) eq 'HASH';
                                $html .= "<strong>" . $#{ $data->{rows} } . "</strong> rows from <code>$class->new" . dump( $self->params ) . "->sponge</code>";
                                $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 ( $self->run eq 'data' ) {
                                my $data = $o->data;
                                $html .= Frey::Dumper->new( data => $data )->markup;
                                $html .= '<hr/><code>' . $self->html_dump( $data ) . '</code>';
                        } else {
                                $html = $self->error( "IGNORE: $class ", $o->dump );
                        }
                };

                $html .= $self->error( $@ ) if $@;
        }

        return $self->page( %$html ) if ref($html) eq 'HASH';
        return $self->page( title => $class, body => $html );
}

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