/[Frey]/trunk/lib/Frey/Mojo/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/Mojo/Run.pm

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

revision 276 by dpavlin, Wed Nov 5 08:20:50 2008 UTC revision 627 by dpavlin, Sat Nov 29 22:02:08 2008 UTC
# Line 3  package Frey::Mojo::Run; Line 3  package Frey::Mojo::Run;
3  use strict;  use strict;
4  use warnings;  use warnings;
5    
6    my $debug = 1;
7    
8  use base 'Mojolicious::Controller';  use base 'Mojolicious::Controller';
9    
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
# Line 10  use Carp qw/confess/; Line 12  use Carp qw/confess/;
12    
13  use Frey::ClassLoader;  use Frey::ClassLoader;
14    
15  warn "# ",dump( Frey::ClassLoader->new->load_all_classes() );  warn "# load_all_classes ",join(',', keys %{ Frey::ClassLoader->new->load_all_classes() } );
16    
17    use Frey::Run;
18    
19  sub markup {  sub as_markup {
20      my ($self, $c) = @_;      my ($self, $c) = @_;
21    
22          warn "# ", dump( $c->match->captures );          warn "# ", dump( $c->match->tx->req->url->query->params );
23    
24          my $params = $c->request->params->to_hash;          my $params = $c->match->tx->req->url->query->params;
25          warn "# params ", dump( $c->request->params );          warn "# params ", dump( $params );
26    
27          my $class = $c->match->captures->{class} || 'Frey::ClassBrowser';          my $class = $c->match->captures->{class} || 'Frey::ClassBrowser';
28          $class =~ s{[/-]}{::}g;          $class =~ s{[/-]}{::}g;
29    
30          my @required =  #       warn "# c ",dump( $c ) if $debug;
31                  grep {  
32                          defined $_ && !defined( $params->{$_} )          my $html = Frey::Run->new(
33                  }                  class => $class,
34                  map {                  request_url => $c->match->tx->req->url,
35                          my $attr = $class->meta->get_attribute($_);          )->html;
                         $attr->is_required && $_  
                 } $class->meta->get_attribute_list;  
   
         warn "## required = ",dump( @required );  
   
         my $html;  
   
         my $values = {};  
         $values = $class->config($class) if $class->can('config');  
   
         if ( @required ) {  
                 $html = qq|<h1>Required params for $class</h1><form method="get">|;  
                 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( %$params );  
                 $o->depends if $o->can('depends');  
   
                 if ( $o->can('markup') ) {  
                         $html = eval { $o->markup };  
                         if ( $@ ) {  
                                 warn $@;  
                                 $html .= qq{<code>$@</code>};  
                         }  
                 } else {  
                         warn "SKIP: $class can't markup";  
                 }  
   
         }  
   
         eval {  
                 # FIXME am I paranoid?  
                 package Mock::Web;  
                 use Moose;  
                 extends 'Frey';  
                 with 'Frey::Web';  
   
                 $html = Mock::Web->new->page(  
                         title => $class,  
                         body => $html,  
                 );  
         };  
36    
37      # Response objec      # Response objec
38      my $res = $c->res;      my $res = $c->res;
# Line 85  sub markup { Line 41  sub markup {
41          $res->body( $html );          $res->body( $html );
42  }  }
43    
44    sub as_data {
45            my ($self, $c) = @_;
46            $self->as_markup( $c );
47    }
48    
49  1;  1;
Legend:
Removed from v.276  
changed lines
  Added in v.627
  ViewVC Help
Powered by ViewVC 1.1.26