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( 'classes' );
};

sub method_link {
        my ( $pkg,$method ) = @_;
        a {
                { href is "/$pkg/$method" }
                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( $pkg, $method ) }
                }
        }
}

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

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 'classes' => sub {
        my $self = shift;
        h1 { 'All classes in image' };
        my $f = Frey->new;
        debug_dump( $f->classes );
};

template 'error' => sub {
        my ( $self, $req, $error ) = shift;
        $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			show( 'classes' );
26			};
27
28	dpavlin	28	sub method_link {
29			my ( $pkg,$method ) = @_;
30			a {
31			{ href is "/$pkg/$method" }
32			outs $method
33			}
34			}
35
36			sub package_methods {
37			my ( $pkg, $methods ) = @_;
38			confess "methods not ARRAY ",dump($methods) unless ref($methods) =~ m/^ARRAY/;
39			outs $pkg;
40			ul {
41			foreach my $method ( @{ $methods } ) {
42			li { method_link( $pkg, $method ) }
43			}
44			}
45			}
46
47			template 'package-methods' => sub {
48			my ( $self, $req, $package ) = @_;
49			$package \|\|= $req->param('package');
50			my $templates = Template::Declare->templates->{ $package } or die "no package $package\n";
51			package_methods( $package, $templates );
52			};
53
54	dpavlin	26	template 'templates' => sub {
55	dpavlin	23	h1 { 'Available templates' };
56			my $templates = Template::Declare->templates;
57	dpavlin	26	debug_dump( $templates );
58	dpavlin	28
59	dpavlin	23	ul {
60	dpavlin	28	foreach my $package ( keys %$templates ) {
61	dpavlin	23	li {
62	dpavlin	28	package_methods( $package, $templates->{$package} );
63	dpavlin	23	}
64			}
65			}
66	dpavlin	2	};
67
68	dpavlin	26	template 'classes' => sub {
69			my $self = shift;
70			h1 { 'All classes in image' };
71			my $f = Frey->new;
72			debug_dump( $f->classes );
73	dpavlin	23	};
74
75	dpavlin	26	template 'error' => sub {
76	dpavlin	28	my ( $self, $req, $error ) = shift;
77			$error \|\|= dump( caller(1) );
78			warn "## error: $error\n";
79			pre {
80	dpavlin	26	{ class is 'error' }
81	dpavlin	28	outs( $error );
82			};
83	dpavlin	26	};
84
85	dpavlin	2	1;