lib/Frey/Run.pm

package Frey::Run;
use Moose;
extends 'Frey';
with 'Frey::Web';
with 'Frey::Config';

=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>, C<html> or C<markup> method on the.

=cut

sub execute { qw/data markup request/ }

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

use Data::Dump qw/dump/;

sub request {
        my ( $self, $req ) = @_;

        my %params = $req->params;
        my $class = $self->class;

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

                warn "## required = ",dump( @required );
                warn "## params = ",dump( %params );

        my $html;

        if ( @required ) {
                $html = qq|<h1>Required params for $class</h1><form method="post">|;
                foreach my $name ( @required ) {
                        my $type = $name =~ m/^pass/ ? 'password' : 'text';
                        my $value = $self->config($class)->{$name};
                        $html .= qq|<label for="$name">$name</label><input type="$type" name="$name" value="$value">|;
                }
                $html .= qq|<input type="submit" value="Run $class"></form>|;
        } else {
                my $o = $class->new( %params );
                $o->depends if $o->can('depends');
                if ( $o->can('request') ) {
                        warn "## turning over to $o->request";
                        $o->request( $req );
                } elsif ( $o->can('markup') ) {
                        warn "## using $o->markup";
                        $html = $o->markup;
                        warn ">>> markup $class ",length( $html ), " bytes\n";
                } elsif ( $o->can('data') ) {
                        $html = '<code>' . dump( $o->data ) . '</code>';
                } else {
                        $html = "IGNORE: $class ", $o->dump;
                        warn $html;
                }
        }

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

1;
1	dpavlin	180	package Frey::Run;
2			use Moose;
3			extends 'Frey';
4			with 'Frey::Web';
5	dpavlin	222	with 'Frey::Config';
6	dpavlin	180
7			=head1 NAME
8
9			Frey::Run - display required form field for Class and run it
10
11	dpavlin	206	=head1 DESCRIPTION
12
13			This object will try to run other Moose objects from your application. It
14	dpavlin	223	will try to invoke C<data>, C<html> or C<markup> method on the.
15	dpavlin	206
16	dpavlin	180	=cut
17
18	dpavlin	223	sub execute { qw/data markup request/ }
19
20	dpavlin	180	has 'class' => (
21			is => 'rw',
22			isa => 'Str',
23			required => 1,
24			);
25
26			use Data::Dump qw/dump/;
27
28	dpavlin	213	sub request {
29	dpavlin	180	my ( $self, $req ) = @_;
30
31			my %params = $req->params;
32			my $class = $self->class;
33
34			my @required =
35			grep {
36			defined $_ && !defined( $params{$_} )
37			}
38			map {
39			my $attr = $class->meta->get_attribute($_);
40			$attr->is_required && $_
41			} $class->meta->get_attribute_list;
42
43			warn "## required = ",dump( @required );
44			warn "## params = ",dump( %params );
45
46			my $html;
47
48			if ( @required ) {
49			$html = qq\|<h1>Required params for $class</h1><form method="post">\|;
50	dpavlin	222	foreach my $name ( @required ) {
51			my $type = $name =~ m/^pass/ ? 'password' : 'text';
52			my $value = $self->config($class)->{$name};
53			$html .= qq\|<label for="$name">$name</label><input type="$type" name="$name" value="$value">\|;
54			}
55	dpavlin	180	$html .= qq\|<input type="submit" value="Run $class"></form>\|;
56			} else {
57			my $o = $class->new( %params );
58			$o->depends if $o->can('depends');
59	dpavlin	213	if ( $o->can('request') ) {
60			warn "## turning over to $o->request";
61			$o->request( $req );
62	dpavlin	204	} elsif ( $o->can('markup') ) {
63	dpavlin	184	warn "## using $o->markup";
64			$html = $o->markup;
65	dpavlin	195	warn ">>> markup $class ",length( $html ), " bytes\n";
66	dpavlin	223	} elsif ( $o->can('data') ) {
67			$html = '<code>' . dump( $o->data ) . '</code>';
68	dpavlin	204	} else {
69			$html = "IGNORE: $class ", $o->dump;
70			warn $html;
71	dpavlin	184	}
72	dpavlin	180	}
73
74			$req->print( $self->page( title => $class, body => $html ) );
75			}
76
77			1;