lib/Frey/Web.pm

package Frey::Web;
use Moose::Role;
use MooseX::AttributeHelpers;

use Continuity::Widget::DomNode;
use Data::Dump qw/dump/;
use Carp qw/confess/;

has 'js' => (
        metaclass => 'Collection::Array',
        is => 'rw',
        isa => 'ArrayRef[Str]',
        default => sub { [] },
        provides => {
                'push' => 'add_js',
        },
);

has 'css' => (
        metaclass => 'Collection::Array',
        is => 'rw',
        isa => 'ArrayRef[Str]',
        default => sub { [ 'static/app.css' ] },
        provides => {
                'push' => 'add_css',
        },
);

sub dom2html {
#       warn "## dom2html ",dump( @_ );
        return Continuity::Widget::DomNode->create( @_ )->to_string;
}

sub _unroll_markup {
#       warn "## _unroll_markup ",dump( @_ );
        my ( $markup, $array ) = @_;
        my $out = '';
        foreach my $path ( @$array ) {
                $path =~ s!^/!!;
                confess "can't find $path" unless -e $path;
                $out .= sprintf( $markup, $path );
        }
        return $out;
}

=head2 add_head

  $o->add_head( 'path/to/external.js' );

  my $size = $o->add_head( 'path/to/external.css' );

=cut

sub add_head {
        my ( $self, $path ) = @_;
        return if ! defined $path || $path eq '';
        $path =~ s!^/!!;

        if ( -e $path ) {
                if ( $path =~ m/\.js$/ ) {
                        $self->add_js( $path );
                } elsif ( $path =~ m/\.css$/ ) {
                        $self->add_css( $path );
                } else {
                        confess "can't add_head( $path ) it's not js or css";
                }
        } else {
                confess "can't find $path: $!";
        }

        return -s $path;
}

our $reload_counter = 0;

sub page {
        my $self = shift;
        my $a = {@_};

        $reload_counter++;

        my $html = qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|
        . _unroll_markup( qq|<script type="text/javascript" src="/%s"></script>|, $self->js )
        . _unroll_markup( qq|<link type="text/css" rel="stylesheet" href="/%s" media="screen">|, $self->css )
        . '<title>' . ( $a->{title} || ref($self) ) . '</title>'
        . ( $a->{head} || '' )
        . '</head><body>'
        . ( $a->{body} || '<!-- no body -->' )
        . qq|<div class="status-line"> <a href="/">Frey</a> $Frey::VERSION <a href="?reload=$reload_counter">reload</a> </div>|
        . '</body></html>'
        ;

        warn "## >>> page ",length($html), " bytes\n" if $self->debug;

        return $html;
}

1;
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 'js' => (
10	metaclass => 'Collection::Array',
11	is => 'rw',
12	isa => 'ArrayRef[Str]',
13	default => sub { [] },
14	provides => {
15	'push' => 'add_js',
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	=head2 add_head
47
48	$o->add_head( 'path/to/external.js' );
49
50	my $size = $o->add_head( 'path/to/external.css' );
51
52	=cut
53
54	sub add_head {
55	my ( $self, $path ) = @_;
56	return if ! defined $path \|\| $path eq '';
57	$path =~ s!^/!!;
58
59	if ( -e $path ) {
60	if ( $path =~ m/\.js$/ ) {
61	$self->add_js( $path );
62	} elsif ( $path =~ m/\.css$/ ) {
63	$self->add_css( $path );
64	} else {
65	confess "can't add_head( $path ) it's not js or css";
66	}
67	} else {
68	confess "can't find $path: $!";
69	}
70
71	return -s $path;
72	}
73
74	our $reload_counter = 0;
75
76	sub page {
77	my $self = shift;
78	my $a = {@_};
79
80	$reload_counter++;
81
82	my $html = qq\|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>\|
83	. _unroll_markup( qq\|<script type="text/javascript" src="/%s"></script>\|, $self->js )
84	. _unroll_markup( qq\|<link type="text/css" rel="stylesheet" href="/%s" media="screen">\|, $self->css )
85	. '<title>' . ( $a->{title} \|\| ref($self) ) . '</title>'
86	. ( $a->{head} \|\| '' )
87	. '</head><body>'
88	. ( $a->{body} \|\| '<!-- no body -->' )
89	. qq\|<div class="status-line"> <a href="/">Frey</a> $Frey::VERSION <a href="?reload=$reload_counter">reload</a> </div>\|
90	. '</body></html>'
91	;
92
93	warn "## >>> page ",length($html), " bytes\n" if $self->debug;
94
95	return $html;
96	}
97
98	1;