/[Frey]/trunk/lib/Frey/Run.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/Run.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 195 by dpavlin, Tue Oct 28 18:33:53 2008 UTC revision 400 by dpavlin, Tue Nov 18 02:16:38 2008 UTC
# Line 1  Line 1 
1  package Frey::Run;  package Frey::Run;
2  use Moose;  use Moose;
3  extends 'Frey';  #extends 'Frey::ClassLoader';
4    extends 'Frey::Action';
5  with 'Frey::Web';  with 'Frey::Web';
6    with 'Frey::Escape';
7    
8    use Data::Dump qw/dump/;
9    use Frey::Dumper;
10    
11  =head1 NAME  =head1 NAME
12    
13  Frey::Run - display required form field for Class and run it  Frey::Run - display required form field for Class and run it
14    
15    =head1 DESCRIPTION
16    
17    This object will try to run other Moose objects from your application. It
18    will try to invoke C<data>, and C<markup> method on the.
19    
20    =head1 SEE ALSO
21    
22    L<Frey::Action> which creates form for params
23    
24  =cut  =cut
25    
26    use Moose::Util::TypeConstraints;
27    
28    sub runnable { qw/data data.js markup sponge/ }
29    enum 'Runnable' => runnable;
30    
31  has 'class' => (  has 'class' => (
32          is => 'rw',          is => 'rw',
33          isa => 'Str',          isa => 'Str',
34          required => 1,          required => 1,
35  );  );
36    
37  use Data::Dump qw/dump/;  has 'params' => (
38            is => 'rw',
39  sub html {          isa => 'HashRef',
40          my ( $self, $req ) = @_;          default => sub { {} },
41    );
         my %params = $req->params;  
         my $class = $self->class;  
42    
43          my @required =  has 'run' => (
44                  grep {          is => 'rw',
45                          defined $_ && !defined( $params{$_} )          isa => 'Runnable',
46                  }          default => 'markup',
47                  map {  );
                         my $attr = $class->meta->get_attribute($_);  
                         $attr->is_required && $_  
                 } $class->meta->get_attribute_list;  
48    
49                  warn "## required = ",dump( @required );  sub html {
50                  warn "## params = ",dump( %params );          my ( $self ) = @_;
51    
52          my $html;          my $html;
53            eval {
54                    my $class = $self->class;
55                    $self->load_class( $class );
56    
57          if ( @required ) {                  if ( $html = $self->params_form ) {
58                  $html = qq|<h1>Required params for $class</h1><form method="post">|;                          warn "got params form for $class";
                 $html .= qq|<label for="$_">$_</label><input type="text" name="$_">| foreach @required;  
                 $html .= qq|<input type="submit" value="Run $class"></form>|;  
         } else {  
                 my $o = $class->new( %params );  
                 $o->depends if $o->can('depends');  
                 if ( $o->can('html') ) {  
                         warn "## turning over to $o->html";  
                         $o->html( $req );  
59                  } else {                  } else {
60                          warn "## using $o->markup";                          my $o;
61                          $html = $o->markup;                          # we don't want default status elements
62                          warn ">>> markup $class ",length( $html ), " bytes\n";                          $self->params->{status} = [];
63                  }                          $o = $class->new( %{ $self->params } );
64          }                          $o->depends if $o->can('depends');
65    
66                            if ( $self->run eq 'markup' ) {
67                                    warn "## using ",ref($o), "->markup";
68                                    $html = $o->markup;
69                                    # preserve status
70                                    push @{ $self->status }, { $class => $o->status } if $o->can('status');
71    
72                                    warn ">>> markup $class ",length( $html ), " bytes\n";
73                            } elsif ( $self->run eq 'sponge' ) {
74                                    my $data = $o->sponge;
75                                    confess "invalid data from sponge = ", dump( $data ) unless ref($data) eq 'HASH';
76                                    my $rows = $#{ $data->{rows} } + 1;
77                                    $rows ||= 'no';
78                                    $html .= "<strong>$rows</strong> rows from <code>$class->new" . dump( $self->params ) . "->sponge</code>";
79                                    $html .= '<table>';
80                                    $html .= '<tr><th>' . join('</th><th>', @{$data->{NAME}} ) . '</th></tr>';
81                                    $html .= '<tr><td>' . join('</td><td>', @$_ ) . '</td></tr>' foreach @{ $data->{rows} };
82                                    $html .= '</table>';
83                            } elsif ( $self->run =~ m{^data(\.(js|json|yaml|yml))?$} ) {
84                                    my $data = $o->data;
85                                    if ( my $format = $1 ) {
86                                            $html .= to_json( $data ) if $format =~ m{js(on)?};
87                                            $html .= Dump( $data )    if $format =~ m{yaml?};
88                                    }
89                                    if ( ! $html ) {
90                                            $html .= Frey::Dumper->new( data => $data )->markup;
91                                            push @{ $self->status }, { 'Dump' => $data };
92                                    }
93                            } else {
94                                    $html = $self->error( "IGNORE: $class ", $o->dump );
95                            }
96                    };
97    
98                    if ( ref($html) eq 'HASH' ) {
99                            $html = $self->page( %$html );
100                    } else {
101                            $html = $self->page( title => $self->class, body => $html );
102                    };
103            };
104    
105            $html = $self->error( $@ ) if $@;
106    
107          $req->print( $self->page( title => $class, body => $html ) );          return $html;
108  }  }
109    
110  1;  1;
Legend:
Removed from v.195  
changed lines
  Added in v.400
  ViewVC Help
Powered by ViewVC 1.1.26