--- trunk/lib/Frey/Run.pm 2008/11/16 00:25:39 349 +++ trunk/lib/Frey/Run.pm 2008/11/19 16:53:13 457 @@ -1,13 +1,15 @@ package Frey::Run; use Moose; #extends 'Frey::ClassLoader'; -extends 'Frey::PPI'; +extends 'Frey::Action'; with 'Frey::Web'; -with 'Frey::Config'; with 'Frey::Escape'; +with 'Frey::Session'; use Data::Dump qw/dump/; use Frey::Dumper; +use JSON; +use YAML; =head1 NAME @@ -18,13 +20,20 @@ This object will try to run other Moose objects from your application. It will try to invoke C, and C method on the. +=head1 SEE ALSO + +L which creates form for params + =cut use Moose::Util::TypeConstraints; -enum 'Runnable' => qw/data markup sponge/; +subtype 'Runnable' + => as 'Str', + => where sub { m{^as_} }; -sub runnable { qw/data markup sponge/ } +sub formats_available { qw/html js json yaml yml/ } +enum 'Formats' => formats_available; has 'class' => ( is => 'rw', @@ -41,94 +50,94 @@ has 'run' => ( is => 'rw', isa => 'Runnable', + default => 'as_markup', +); + +has 'format' => ( + is => 'rw', + isa => 'Formats', + default => 'html', ); sub html { my ( $self ) = @_; - my $class = $self->class; + my ($html,$body,$data); + eval { + my $class = $self->class; + $self->load_class( $class ); + + if ( $body = $self->params_form ) { + warn "got required params form for $class ", $self->run, " format: ", $self->format; + } else { - $self->load_class( $class ); + $self->usage->{ $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|

$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 = ''; - 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 ); + my $o; + my ( $meta, $is_role, $instance ) = $self->class_meta( $class ); + if ( $is_role ) { + $o = $instance; + } else { + $o = $self->new_frey_class( $class, $self->params ); } - $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( %{ $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{$@}; + $o->depends if $o->can('depends'); + + push @{ $self->status }, { qq|$class| => $self->params }; + + if ( $self->run eq 'as_markup' ) { + warn "## using ",ref($o), "->as_markup"; + if ( $o->can('page') ) { + $html = $o->page; + } + $body = $o->as_markup unless $html; + + warn ">>> markup $class ",length( $html || $body ), " ", $html ? 'html' : 'body', " bytes"; + } elsif ( $self->run eq 'as_sponge' ) { + $data = $o->as_sponge; + confess "invalid data from sponge = ", dump( $data ) unless ref($data) eq 'HASH'; + if ( $self->format eq 'html' ) { + my $rows = $#{ $data->{rows} } + 1; + $rows ||= 'no'; + $body .= "$rows rows from $class->new" . dump( $self->params ) . "->as_sponge"; + $body .= ''; + $body .= ''; + $body .= '' foreach @{ $data->{rows} }; + $body .= '
' . join('', @{$data->{NAME}} ) . '
' . join('', @$_ ) . '
'; + } + } elsif ( $self->run eq 'as_data' ) { + $data = $o->as_data; + } else { + $body = $self->error( "IGNORE: $class ", $o->dump ); } - warn ">>> markup $class ",length( $html ), " bytes\n"; - } elsif ( $o->can('sponge') ) { - my $data = $o->sponge; - $html .= ''; - $html .= ''; - $html .= '' foreach @{ $data->{rows} }; - $html .= '
' . join('', @{$data->{NAME}} ) . '
' . join('', @$_ ) . '
'; - } elsif ( $o->can('data') ) { - my $data = $o->data; - $html .= Frey::Dumper->new( data => $data )->markup; - $html .= '
' . $self->html_dump( $data ) . ''; - } else { - $html = "IGNORE: $class ", $o->dump; - warn $html; - } - } - return $self->page( title => $class, body => $html ); + if ( defined $data ) { + $html .= to_json( $data ) if $self->format =~ m{js(on)?}; + $html .= Dump( $data ) if $self->format =~ m{ya?ml}; + push @{ $self->status }, { 'data' => $data }; + } + if ( ! $html ) { + $body .= Frey::Dumper->new( data => $data )->as_markup; + } + + # override our status with one from object + eval { + $self->status( $o->status ); + }; + warn "can't override status: $@" if $@; + }; + + + if ( ref($body) eq 'HASH' ) { + $html = $self->page( %$body ); + } elsif ( $body && ! $html ) { + $html = $self->page( title => $self->class . ' run', body => $body ); + }; + }; + + $html = $self->page( title => $self->class, body => $self->error( $@ ) ) if $@; + + return $html; } 1;