lib/Frey/Run.pm

package Frey::Run;
use Moose;
extends 'Frey::ClassLoader';
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/ }

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