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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 121 - (show annotations)
Mon Jul 14 21:22:43 2008 UTC (14 years, 6 months ago) by dpavlin
File size: 1520 byte(s)
central page creation [0.11]

- make (optional) development feature in Makefile.PL
- split page generation in Frey::Web->page
- cleanup of html generation code all over
- jump to Carp::REPL on errors (nice, but needs to be in browser)

This is a move to more embedded html. While it does seem evil, we are aming
here at lean framework, so readability is prefered...
1 package Frey::Web;
2 use Moose::Role;
3 use MooseX::AttributeHelpers;
4
5 use Continuity::Widget::DomNode;
6 use Data::Dump qw/dump/;
7 use Carp qw/confess/;
8
9 has 'javascript' => (
10 metaclass => 'Collection::Array',
11 is => 'rw',
12 isa => 'ArrayRef[Str]',
13 default => sub { [] },
14 provides => {
15 'push' => 'add_javascript',
16 },
17 );
18
19 has 'css' => (
20 metaclass => 'Collection::Array',
21 is => 'rw',
22 isa => 'ArrayRef[Str]',
23 default => sub { [ 'static/app.css' ] },
24 provides => {
25 'push' => 'add_css',
26 },
27 );
28
29 sub dom2html {
30 # warn "## dom2html ",dump( @_ );
31 return Continuity::Widget::DomNode->create( @_ )->to_string;
32 }
33
34 sub _unroll_markup {
35 # warn "## _unroll_markup ",dump( @_ );
36 my ( $markup, $array ) = @_;
37 my $out = '';
38 foreach my $path ( @$array ) {
39 $path =~ s!^/!!;
40 confess "can't find $path" unless -e $path;
41 $out .= sprintf( $markup, $path );
42 }
43 return $out;
44 }
45
46 sub page {
47 my $self = shift;
48 my $a = {@_};
49
50 my $html = qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|
51 . _unroll_markup( qq|<script type="text/javascript" src="/%s"></script>|, $self->javascript )
52 . _unroll_markup( qq|<link type="text/css" rel="stylesheet" href="/%s" media="screen">|, $self->css )
53 . '<title>' . ( $a->{title} || ref($self) ) . '</title>'
54 . ( $a->{head} || '' )
55 . '</head><body>'
56 . ( $a->{body} || '<!-- no body -->' )
57 . qq|<div class="status-line"> <a href="/">Frey</a> $Frey::VERSION </div>|
58 . '</body></html>'
59 ;
60
61 warn "## >>> page ",length($html), " bytes\n" if $self->debug;
62
63 return $html;
64 }
65
66 1;

  ViewVC Help
Powered by ViewVC 1.1.26