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

=cut

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";
                } 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			will try to invoke C<html> or C<markup> method on the.
15
16	dpavlin	180	=cut
17
18			has 'class' => (
19			is => 'rw',
20			isa => 'Str',
21			required => 1,
22			);
23
24			use Data::Dump qw/dump/;
25
26	dpavlin	213	sub request {
27	dpavlin	180	my ( $self, $req ) = @_;
28
29			my %params = $req->params;
30			my $class = $self->class;
31
32			my @required =
33			grep {
34			defined $_ && !defined( $params{$_} )
35			}
36			map {
37			my $attr = $class->meta->get_attribute($_);
38			$attr->is_required && $_
39			} $class->meta->get_attribute_list;
40
41			warn "## required = ",dump( @required );
42			warn "## params = ",dump( %params );
43
44			my $html;
45
46			if ( @required ) {
47			$html = qq\|<h1>Required params for $class</h1><form method="post">\|;
48	dpavlin	222	foreach my $name ( @required ) {
49			my $type = $name =~ m/^pass/ ? 'password' : 'text';
50			my $value = $self->config($class)->{$name};
51			$html .= qq\|<label for="$name">$name</label><input type="$type" name="$name" value="$value">\|;
52			}
53	dpavlin	180	$html .= qq\|<input type="submit" value="Run $class"></form>\|;
54			} else {
55			my $o = $class->new( %params );
56			$o->depends if $o->can('depends');
57	dpavlin	213	if ( $o->can('request') ) {
58			warn "## turning over to $o->request";
59			$o->request( $req );
60	dpavlin	204	} elsif ( $o->can('markup') ) {
61	dpavlin	184	warn "## using $o->markup";
62			$html = $o->markup;
63	dpavlin	195	warn ">>> markup $class ",length( $html ), " bytes\n";
64	dpavlin	204	} else {
65			$html = "IGNORE: $class ", $o->dump;
66			warn $html;
67	dpavlin	184	}
68	dpavlin	180	}
69
70			$req->print( $self->page( title => $class, body => $html ) );
71			}
72
73			1;