lib/Frey/View.pm

package Frey::View;

use strict;
use warnings;

use Template::Declare::Tags; # defaults to 'HTML'
use Frey;
use base qw/Template::Declare/;
use Data::Dump qw/dump/;
use Carp qw/carp confess/;

sub debug_dump {
        my $dump = dump( @_ );
        carp "debug_dump $dump\n";
        pre {
                { class is 'debug' }
                outs $dump;
        }
}

template 'status' => sub {
        my ( $self ) = @_;
        p { 'Welcome to Frey' };
        show( 'templates' );
        show( 'packages' );
        show( 'introspect' );
};

sub method_link {
        my ( $pkg,$method ) = @_;
        my $url = "/$pkg/$method";
        $url = $method if $method =~ m!^/!;
        a {
                { href is $url }
                outs $method
        }
}

sub package_methods {
        my ( $pkg, $methods ) = @_;
        confess "methods not ARRAY ",dump($methods) unless ref($methods) =~ m/^ARRAY/;
        outs $pkg;
        ul {
                foreach my $method ( @{ $methods } ) {
                        li { method_link( "crud/$pkg", $method ) }
                }
        }
}

template 'package-templates' => sub {
        my ( $self, $req, $package ) = @_;
        $package ||= $req->param('package');
        my $methods = Template::Declare->templates->{ $package } or die "no package $package\n";
        package_methods( $package, $methods );
};

template 'templates' => sub {
        h1 { 'Available templates' };
        my $templates = Template::Declare->templates;
        debug_dump( $templates );

        ul {
                foreach my $package ( keys %$templates ) {
                        li {
                                package_methods( $package, $templates->{$package} );
                        }
                }
        }
};

template 'packages' => sub {
        my $self = shift;
        h1 { 'All packages in image' };
        my $f = Frey->new;
        debug_dump( $f->classes );
};

use Frey::Introspect;

template 'introspect' => sub {
        my $self = shift;
        h1 { 'Introspect Moose packages' };
        ul {
                map {
                        my ( $package, $path ) = each( %$_ );
                        li {
                                outs $package;
                                my $f = Frey::Introspect->new( package => $package );
                                my ( $class, $meta, $is_role ) = $f->load_package();
                                if ( $class->can('meta') ) {
                                        ul {
                                                foreach my $m ( $f->methods ) {
                                                        li { method_link( $package, $m ) }
                                                }
                                        }
                                        pre {
                                                { class is 'debug' };
                                                outs $class->dump( 1 );
                                        }
                                } else {
                                        b { "not introspectable" }
                                }
                        }
                } @{ Frey->new->classes };
        }
};

template 'error' => sub {
        my ( $self, $req, $error ) = @_;
        $error ||= dump( caller(1) );
        warn "## error: $error\n";
        pre {
                { class is 'error' }
                outs( $error );
        };
};

1;
1	dpavlin	21	package Frey::View;
2	dpavlin	2
3			use strict;
4			use warnings;
5
6			use Template::Declare::Tags; # defaults to 'HTML'
7	dpavlin	26	use Frey;
8			use base qw/Template::Declare/;
9	dpavlin	2	use Data::Dump qw/dump/;
10	dpavlin	28	use Carp qw/carp confess/;
11	dpavlin	2
12	dpavlin	26	sub debug_dump {
13			my $dump = dump( @_ );
14			carp "debug_dump $dump\n";
15			pre {
16			{ class is 'debug' }
17			outs $dump;
18			}
19			}
20
21			template 'status' => sub {
22	dpavlin	19	my ( $self ) = @_;
23	dpavlin	28	p { 'Welcome to Frey' };
24	dpavlin	26	show( 'templates' );
25	dpavlin	53	show( 'packages' );
26			show( 'introspect' );
27	dpavlin	26	};
28
29	dpavlin	28	sub method_link {
30			my ( $pkg,$method ) = @_;
31	dpavlin	41	my $url = "/$pkg/$method";
32			$url = $method if $method =~ m!^/!;
33	dpavlin	28	a {
34	dpavlin	41	{ href is $url }
35	dpavlin	28	outs $method
36			}
37			}
38
39			sub package_methods {
40			my ( $pkg, $methods ) = @_;
41			confess "methods not ARRAY ",dump($methods) unless ref($methods) =~ m/^ARRAY/;
42			outs $pkg;
43			ul {
44			foreach my $method ( @{ $methods } ) {
45	dpavlin	53	li { method_link( "crud/$pkg", $method ) }
46	dpavlin	28	}
47			}
48			}
49
50	dpavlin	53	template 'package-templates' => sub {
51	dpavlin	28	my ( $self, $req, $package ) = @_;
52			$package \|\|= $req->param('package');
53	dpavlin	32	my $methods = Template::Declare->templates->{ $package } or die "no package $package\n";
54			package_methods( $package, $methods );
55	dpavlin	28	};
56
57	dpavlin	26	template 'templates' => sub {
58	dpavlin	23	h1 { 'Available templates' };
59			my $templates = Template::Declare->templates;
60	dpavlin	26	debug_dump( $templates );
61	dpavlin	28
62	dpavlin	23	ul {
63	dpavlin	28	foreach my $package ( keys %$templates ) {
64	dpavlin	23	li {
65	dpavlin	28	package_methods( $package, $templates->{$package} );
66	dpavlin	23	}
67			}
68			}
69	dpavlin	2	};
70
71	dpavlin	53	template 'packages' => sub {
72	dpavlin	26	my $self = shift;
73	dpavlin	32	h1 { 'All packages in image' };
74	dpavlin	26	my $f = Frey->new;
75			debug_dump( $f->classes );
76	dpavlin	23	};
77
78	dpavlin	53	use Frey::Introspect;
79
80			template 'introspect' => sub {
81			my $self = shift;
82			h1 { 'Introspect Moose packages' };
83			ul {
84			map {
85			my ( $package, $path ) = each( %$_ );
86			li {
87			outs $package;
88			my $f = Frey::Introspect->new( package => $package );
89			my ( $class, $meta, $is_role ) = $f->load_package();
90			if ( $class->can('meta') ) {
91			ul {
92			foreach my $m ( $f->methods ) {
93			li { method_link( $package, $m ) }
94			}
95			}
96			pre {
97			{ class is 'debug' };
98			outs $class->dump( 1 );
99			}
100			} else {
101			b { "not introspectable" }
102			}
103			}
104			} @{ Frey->new->classes };
105			}
106			};
107
108	dpavlin	26	template 'error' => sub {
109	dpavlin	32	my ( $self, $req, $error ) = @_;
110	dpavlin	28	$error \|\|= dump( caller(1) );
111			warn "## error: $error\n";
112			pre {
113	dpavlin	26	{ class is 'error' }
114	dpavlin	28	outs( $error );
115			};
116	dpavlin	26	};
117
118	dpavlin	2	1;