/[Frey]/trunk/lib/Frey/View.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

Contents of /trunk/lib/Frey/View.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (show annotations)
Sun Jun 29 20:52:33 2008 UTC (15 years, 10 months ago) by dpavlin
File size: 1593 byte(s)
Remove Frey::REST and merge it into Strix::View

Various other fixes along the way...
1 package Frey::View;
2
3 use strict;
4 use warnings;
5
6 use Template::Declare::Tags; # defaults to 'HTML'
7 use Frey;
8 use base qw/Template::Declare/;
9 use Data::Dump qw/dump/;
10 use Carp qw/carp confess/;
11
12 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 my ( $self ) = @_;
23 p { 'Welcome to Frey' };
24 show( 'templates' );
25 show( 'classes' );
26 };
27
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 $methods = Template::Declare->templates->{ $package } or die "no package $package\n";
51 package_methods( $package, $methods );
52 };
53
54 template 'templates' => sub {
55 h1 { 'Available templates' };
56 my $templates = Template::Declare->templates;
57 debug_dump( $templates );
58
59 ul {
60 foreach my $package ( keys %$templates ) {
61 li {
62 package_methods( $package, $templates->{$package} );
63 }
64 }
65 }
66 };
67
68 template 'classes' => sub {
69 my $self = shift;
70 h1 { 'All packages in image' };
71 my $f = Frey->new;
72 debug_dump( $f->classes );
73 };
74
75 template 'error' => sub {
76 my ( $self, $req, $error ) = @_;
77 $error ||= dump( caller(1) );
78 warn "## error: $error\n";
79 pre {
80 { class is 'error' }
81 outs( $error );
82 };
83 };
84
85 1;

  ViewVC Help
Powered by ViewVC 1.1.26