lib/Frey/Run.pm

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

=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/ }

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

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

use Data::Dump qw/dump/;

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

        my $class = $self->class;

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

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

        my $html;
        my $values = {};
        my $values = $self->config($class) if $self->can('config');

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