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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 392 - (show annotations)
Tue Nov 18 00:55:23 2008 UTC (15 years, 4 months ago) by dpavlin
Original Path: trunk/lib/Frey/Web.pm
File size: 3737 byte(s)
finish request_url support so it works now
1 package Frey::Web;
2 use Moose::Role;
3
4 use Frey::Types;
5
6 use Continuity::Widget::DomNode;
7 use Data::Dump qw/dump/;
8 use Carp qw/confess/;
9 use File::Slurp;
10
11 has 'head' => (
12 is => 'rw',
13 isa => 'ArrayRef[Str]',
14 default => sub { [ 'static/frey.css' ] },
15 );
16
17 has 'status' => (
18 is => 'rw',
19 isa => 'ArrayRef[HashRef[Str]]',
20 lazy => 1,
21 default => sub { [
22 { 'Bookmarklets' => Frey::Bookmarklet->markup },
23 { 'ClassBrowser' => Frey::ClassBrowser->markup },
24 ] },
25 );
26
27 has 'request_url' => (
28 is => 'rw',
29 isa => 'Uri', coerce => 1,
30 default => '/',
31 );
32
33 =head2 inline_smaller_than
34
35 Inline JavaScript and CSS smaller than this size into page reducing
36 round-trips to server.
37
38 =cut
39
40 has 'inline_smaller_than' => (
41 is => 'rw',
42 isa => 'Int',
43 default => 10240,
44 );
45
46 sub dom2html {
47 # warn "## dom2html ",dump( @_ );
48 return Continuity::Widget::DomNode->create( @_ )->to_string;
49 }
50
51 sub _inline_path {
52 my ( $self, $path ) = @_;
53 -s $path < $self->inline_smaller_than;
54 }
55
56 sub _head_html {
57 my $self = shift;
58 my $out = '';
59 foreach my $path ( @{ $self->head } ) {
60 $path =~ s!^/!!;
61 if ( $path =~ m/\.js$/ ) {
62 $out .= $self->_inline_path( $path ) ?
63 qq|<!-- $path --><script type="text/javascript">\n| . read_file($path) . qq|\n</script>| :
64 qq|<script type="text/javascript" src="/$path"></script>|;
65 } elsif ( $path =~ m/\.css$/ ) {
66 $out .= $self->_inline_path( $path ) ?
67 qq|<!-- $path --><style type="text/css">\n| . read_file( $path ) . qq|\n</style>| :
68 qq|<link type="text/css" rel="stylesheet" href="/$path" media="screen">|;
69 } else {
70 confess "don't know how to render $path";
71 }
72 $out .= "\n";
73 }
74 return $out;
75 }
76
77 =head2 add_head
78
79 $o->add_head( 'path/to/external.js' );
80
81 my $size = $o->add_head( 'path/to/external.css' );
82
83 =cut
84
85 sub add_head {
86 my ( $self, $path ) = @_;
87 return if ! defined $path || $path eq '';
88 $path =~ s!^/!!;
89
90 if ( -e $path ) {
91 if ( $path =~ m/\.(?:js|css)$/ ) {
92 push @{ $self->head }, $path;
93 } else {
94 confess "can't add_head( $path ) it's not js or css";
95 }
96 } else {
97 confess "can't find $path: $!";
98 }
99
100 return -s $path;
101 }
102
103 our $reload_counter = 0;
104
105
106 =head2 page
107
108 $self->page(
109 title => 'page title',
110 head => '<!-- optional head markup -->',
111 body => '<b>Page Body</b>',
112 );
113
114 =cut
115
116 use Frey::Bookmarklet;
117 use Frey::ClassBrowser;
118
119 sub page {
120 my $self = shift;
121 my $a = {@_};
122
123 $reload_counter++;
124
125 my $status_line = '';
126 foreach my $part ( @{ $self->status } ) {
127 foreach my $name ( keys %$part ) {
128 my $content = $part->{$name};
129 if ( ref($content) ) {
130 $content = '<code>' . dump( $content ) . '</code>';
131 } else {
132 $content = qq|<span>$content</span>|;
133 }
134 warn "### part [$name] = ", length( $content ), " bytes" if $self->debug;
135 $status_line .= qq|<span class="frey-popup">$name $content</span>|;
136 }
137 }
138
139 my $html = join("\n",
140 qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|,
141 $self->_head_html,
142 '<title>' . ( $a->{title} || ref($self) ) . '</title>',
143 '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">',
144 ( $a->{head} || '' ),
145 '</head><body>',
146 ( $a->{body} || '<!-- no body -->' ),
147 qq|
148 <div class="frey-status-line">
149 <a href="/">Frey</a> $Frey::VERSION
150 <a href="?reload=$reload_counter"><code>| . $self->request_url . qq|</code></a>
151 $status_line
152 </div>
153 </body></html>
154 |,
155 );
156
157 warn "## >>> page ",length($html), " bytes\n" if $self->debug;
158
159 return $html;
160 }
161
162 sub error {
163 my ( $self, $error ) = @_;
164 my ($package, $filename, $line) = caller;
165 $error .= " at $filename line $line";
166 warn "WARN: $error\n";
167 $error =~ s{at\s+(\S+)\s+line\s+(\d+)}{at <a href="/editor$1+$2" target="editor">$1</a> line $2}gsm;
168 return qq|<pre class="frey-error">$error</pre>|;
169 }
170
171 1;

  ViewVC Help
Powered by ViewVC 1.1.26