/[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 276 - (hide annotations)
Wed Nov 5 08:20:50 2008 UTC (15 years, 6 months ago) by dpavlin
File size: 1810 byte(s)
 r3096@llin (orig r242):  dpavlin | 2008-11-02 19:27:19 +0100
  r306@eeepy:  dpavlin | 2008-11-02 17:50:33 +0100
  wrap required parametars into page html
 

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 }
67    
68 dpavlin 276 eval {
69     # FIXME am I paranoid?
70     package Mock::Web;
71     use Moose;
72     extends 'Frey';
73     with 'Frey::Web';
74    
75     $html = Mock::Web->new->page(
76     title => $class,
77     body => $html,
78     );
79     };
80    
81 dpavlin 272 # Response objec
82     my $res = $c->res;
83     $res->code(200);
84     $res->headers->content_type('text/html');
85     $res->body( $html );
86 dpavlin 268 }
87    
88     1;

  ViewVC Help
Powered by ViewVC 1.1.26