/[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

Annotation of /trunk/lib/Frey/Mojo/Run.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 275 - (hide annotations)
Wed Nov 5 08:20:49 2008 UTC (15 years, 6 months ago) by dpavlin
File size: 1820 byte(s)
 r3095@llin (orig r241):  dpavlin | 2008-11-02 19:27:18 +0100
  r305@eeepy:  dpavlin | 2008-11-02 17:23:45 +0100
  ported Frey::Run parts to Frey::Mojo::Run so that we ask for
  required arguments
 

1 dpavlin 268 package Frey::Mojo::Run;
2    
3     use strict;
4     use warnings;
5    
6     use base 'Mojolicious::Controller';
7    
8     use Data::Dump qw/dump/;
9     use Carp qw/confess/;
10    
11 dpavlin 272 use Frey::ClassLoader;
12    
13     warn "# ",dump( Frey::ClassLoader->new->load_all_classes() );
14    
15    
16 dpavlin 268 sub markup {
17     my ($self, $c) = @_;
18    
19     warn "# ", dump( $c->match->captures );
20    
21     my $params = $c->request->params->to_hash;
22 dpavlin 275 warn "# params ", dump( $c->request->params );
23 dpavlin 268
24     my $class = $c->match->captures->{class} || 'Frey::ClassBrowser';
25     $class =~ s{[/-]}{::}g;
26    
27 dpavlin 275 my @required =
28     grep {
29     defined $_ && !defined( $params->{$_} )
30     }
31     map {
32     my $attr = $class->meta->get_attribute($_);
33     $attr->is_required && $_
34     } $class->meta->get_attribute_list;
35 dpavlin 268
36 dpavlin 275 warn "## required = ",dump( @required );
37    
38 dpavlin 272 my $html;
39 dpavlin 275
40     my $values = {};
41     $values = $class->config($class) if $class->can('config');
42    
43     if ( @required ) {
44     $html = qq|<h1>Required params for $class</h1><form method="get">|;
45     foreach my $name ( @required ) {
46     my $type = $name =~ m/^pass/ ? 'password' : 'text';
47     my $value = $values ? $values->{$name} : '';
48     $html .= qq|<label for="$name">$name</label><input type="$type" name="$name" value="$value">|;
49 dpavlin 272 }
50 dpavlin 275 $html .= qq|<input type="submit" value="Run $class"></form>|;
51 dpavlin 272 } else {
52    
53 dpavlin 275 my $o = $class->new( %$params );
54     $o->depends if $o->can('depends');
55 dpavlin 272
56 dpavlin 275 if ( $o->can('markup') ) {
57     $html = eval { $o->markup };
58     if ( $@ ) {
59     warn $@;
60     $html .= qq{<code>$@</code>};
61     }
62     } else {
63     warn "SKIP: $class can't markup";
64     }
65 dpavlin 272
66 dpavlin 275 eval {
67     # FIXME am I paranoid?
68     package Mock::Web;
69     use Moose;
70     extends 'Frey';
71     with 'Frey::Web';
72    
73     $html = Mock::Web->new->page(
74     title => $class,
75     body => $html,
76     );
77     };
78     }
79    
80 dpavlin 272 # Response objec
81     my $res = $c->res;
82     $res->code(200);
83     $res->headers->content_type('text/html');
84     $res->body( $html );
85 dpavlin 268 }
86    
87     1;

  ViewVC Help
Powered by ViewVC 1.1.26