--- trunk/lib/Frey/Run.pm 2008/11/01 00:14:05 223 +++ trunk/lib/Frey/Run.pm 2008/11/16 17:50:25 363 @@ -1,8 +1,13 @@ package Frey::Run; use Moose; -extends 'Frey'; +#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 @@ -11,11 +16,15 @@ =head1 DESCRIPTION This object will try to run other Moose objects from your application. It -will try to invoke C, C or C method on the. +will try to invoke C, and C method on the. =cut -sub execute { qw/data markup request/ } +use Moose::Util::TypeConstraints; + +enum 'Runnable' => qw/data markup sponge/; + +sub runnable { qw/data markup sponge/ } has 'class' => ( is => 'rw', @@ -23,55 +32,110 @@ required => 1, ); -use Data::Dump qw/dump/; +has 'params' => ( + is => 'rw', + isa => 'HashRef', + default => sub { {} }, +); + +has 'run' => ( + is => 'rw', + isa => 'Runnable', + default => 'markup', +); -sub request { - my ( $self, $req ) = @_; +sub html { + my ( $self ) = @_; - my %params = $req->params; my $class = $self->class; + $self->load_class( $class ); + my @required = grep { - defined $_ && !defined( $params{$_} ) + defined $_ && $_->can('name') && !defined( $self->params->{ $_->name } ) } map { my $attr = $class->meta->get_attribute($_); - $attr->is_required && $_ + $attr->is_required && $attr; } $class->meta->get_attribute_list; - warn "## required = ",dump( @required ); - warn "## params = ",dump( %params ); + 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|

Required params for $class

|; - foreach my $name ( @required ) { + $html = qq|

$class params

|; + + 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 = $self->config($class)->{$name}; - $html .= qq||; + my $value = ''; + my $value_html = ''; + if ( ref($values) eq 'HASH' ) { + $value = $values->{$name}; + } elsif ( ref($values) eq 'ARRAY' ) { + $value_html = qq||; + } elsif ( $attr->has_type_constraint && $attr->type_constraint->can('values') ) { + $value_html = qq||; + } elsif ( $attr->has_default ) { + $value = $attr->default( $name ); + } + $value_html = qq|| unless $value_html; + +#warn "# required $name ", $class->meta->get_attribute( $name )->dump( 2 ); + $html .= qq|| . $value_html; } $html .= qq|
|; } 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 = '' . dump( $o->data ) . ''; - } else { - $html = "IGNORE: $class ", $o->dump; - warn $html; - } + 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'; + my $rows = $#{ $data->{rows} } + 1; + $rows ||= 'no'; + $html .= "$rows rows from $class->new" . dump( $self->params ) . "->sponge"; + $html .= ''; + $html .= ''; + $html .= '' foreach @{ $data->{rows} }; + $html .= '
' . join('', @{$data->{NAME}} ) . '
' . join('', @$_ ) . '
'; + } elsif ( $self->run eq 'data' ) { + my $data = $o->data; + $html .= Frey::Dumper->new( data => $data )->markup; + $html .= '
dump' . $self->html_dump( $data ) . ''; + } else { + $html = $self->error( "IGNORE: $class ", $o->dump ); + } + }; + + $html .= $self->error( $@ ) if $@; } - $req->print( $self->page( title => $class, body => $html ) ); + return $self->page( %$html ) if ref($html) eq 'HASH'; + return $self->page( title => $class, body => $html ); } 1;