/[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

Annotation of /trunk/lib/Frey/Web.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 473 - (hide annotations)
Thu Nov 20 11:56:41 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 5132 byte(s)
re-order status line for more logical positions

ClassBrowser is now first because it opens on fixed position from the left,
and this ensures that pop-up from ClassBrowser is wide enough to mouse
over to it...

Move current url to right, last thing in line is warn, and before
that is name of executed Action
1 dpavlin 100 package Frey::Web;
2     use Moose::Role;
3    
4 dpavlin 465 with 'Frey::Backtrace';
5    
6 dpavlin 388 use Frey::Types;
7    
8 dpavlin 100 use Continuity::Widget::DomNode;
9     use Data::Dump qw/dump/;
10 dpavlin 389 use Carp qw/confess/;
11 dpavlin 161 use File::Slurp;
12 dpavlin 100
13 dpavlin 410 use Frey::Bookmarklet;
14     use Frey::ClassBrowser;
15    
16 dpavlin 156 has 'head' => (
17 dpavlin 121 is => 'rw',
18     isa => 'ArrayRef[Str]',
19 dpavlin 160 default => sub { [ 'static/frey.css' ] },
20 dpavlin 121 );
21    
22 dpavlin 388 has 'status' => (
23     is => 'rw',
24     isa => 'ArrayRef[HashRef[Str]]',
25     lazy => 1,
26     default => sub { [
27 dpavlin 473 { 'ClassBrowser' => Frey::ClassBrowser->new( usage_on_top => 0 )->as_markup },
28 dpavlin 455 { 'Bookmarklets' => Frey::Bookmarklet->new->as_markup },
29 dpavlin 388 ] },
30     );
31    
32 dpavlin 392 has 'request_url' => (
33 dpavlin 388 is => 'rw',
34     isa => 'Uri', coerce => 1,
35     default => '/',
36     );
37    
38 dpavlin 418 has 'title' => (
39     is => 'rw',
40     isa => 'Str',
41     lazy => 1,
42     default => sub {
43     my ($self) = @_;
44     ref($self);
45     },
46     );
47    
48 dpavlin 448 has 'content_type' => (
49     is => 'rw',
50     isa => 'Str',
51     default => 'text/html',
52     );
53    
54 dpavlin 206 =head2 inline_smaller_than
55    
56     Inline JavaScript and CSS smaller than this size into page reducing
57     round-trips to server.
58    
59     =cut
60    
61 dpavlin 161 has 'inline_smaller_than' => (
62     is => 'rw',
63     isa => 'Int',
64     default => 10240,
65     );
66    
67 dpavlin 100 sub dom2html {
68 dpavlin 106 # warn "## dom2html ",dump( @_ );
69 dpavlin 100 return Continuity::Widget::DomNode->create( @_ )->to_string;
70     }
71    
72 dpavlin 161 sub _inline_path {
73     my ( $self, $path ) = @_;
74     -s $path < $self->inline_smaller_than;
75     }
76    
77 dpavlin 156 sub _head_html {
78     my $self = shift;
79 dpavlin 121 my $out = '';
80 dpavlin 156 foreach my $path ( @{ $self->head } ) {
81 dpavlin 121 $path =~ s!^/!!;
82 dpavlin 156 if ( $path =~ m/\.js$/ ) {
83 dpavlin 161 $out .= $self->_inline_path( $path ) ?
84 dpavlin 163 qq|<!-- $path --><script type="text/javascript">\n| . read_file($path) . qq|\n</script>| :
85 dpavlin 161 qq|<script type="text/javascript" src="/$path"></script>|;
86 dpavlin 156 } elsif ( $path =~ m/\.css$/ ) {
87 dpavlin 161 $out .= $self->_inline_path( $path ) ?
88 dpavlin 163 qq|<!-- $path --><style type="text/css">\n| . read_file( $path ) . qq|\n</style>| :
89 dpavlin 161 qq|<link type="text/css" rel="stylesheet" href="/$path" media="screen">|;
90 dpavlin 446 } elsif ( $path =~ m{<.+>}s ) {
91 dpavlin 444 $out .= $path;
92 dpavlin 156 } else {
93     confess "don't know how to render $path";
94     }
95 dpavlin 163 $out .= "\n";
96 dpavlin 121 }
97     return $out;
98     }
99 dpavlin 100
100 dpavlin 154 =head2 add_head
101    
102     $o->add_head( 'path/to/external.js' );
103    
104     my $size = $o->add_head( 'path/to/external.css' );
105    
106 dpavlin 445 $o->add_head( '<!-- html content -->' );
107    
108 dpavlin 154 =cut
109    
110     sub add_head {
111     my ( $self, $path ) = @_;
112     return if ! defined $path || $path eq '';
113     $path =~ s!^/!!;
114    
115 dpavlin 446 if ( $path =~ m{<.*>}s ) {
116 dpavlin 444 push @{ $self->head }, $path;
117     } elsif ( -e $path ) {
118 dpavlin 156 if ( $path =~ m/\.(?:js|css)$/ ) {
119     push @{ $self->head }, $path;
120 dpavlin 154 } else {
121     confess "can't add_head( $path ) it's not js or css";
122     }
123 dpavlin 444 return -s $path;
124 dpavlin 154 } else {
125     confess "can't find $path: $!";
126     }
127    
128     }
129    
130 dpavlin 142 our $reload_counter = 0;
131    
132 dpavlin 183
133     =head2 page
134    
135     $self->page(
136     title => 'page title',
137     head => '<!-- optional head markup -->',
138     body => '<b>Page Body</b>',
139     );
140    
141     =cut
142    
143 dpavlin 121 sub page {
144 dpavlin 100 my $self = shift;
145 dpavlin 121 my $a = {@_};
146 dpavlin 100
147 dpavlin 142 $reload_counter++;
148    
149 dpavlin 388 my $status_line = '';
150     foreach my $part ( @{ $self->status } ) {
151 dpavlin 422 if ( ref($part) ne 'HASH' ) {
152     warn "part not hash ",dump( $part ) ;
153     #$self->status( $part );
154     next;
155     }
156 dpavlin 388 foreach my $name ( keys %$part ) {
157 dpavlin 392 my $content = $part->{$name};
158     if ( ref($content) ) {
159 dpavlin 397 $content = '<code>' . dump($content) . '</code>';
160     my $l = length($content);
161     $content = qq|<span>$l bytes</span>| if $l > 1024;
162 dpavlin 392 } else {
163     $content = qq|<span>$content</span>|;
164     }
165     warn "### part [$name] = ", length( $content ), " bytes" if $self->debug;
166 dpavlin 397 $status_line .= qq|<span class="frey-popup">$name $content</span>\n|;
167 dpavlin 388 }
168     }
169    
170 dpavlin 439 my $url = $self->request_url;
171     $url =~ s{\?reload=\d+}{};
172    
173 dpavlin 460 my $body = $a->{body};
174     $body ||= $self->as_markup if $self->can('as_markup');
175     if ( $self->content_type !~ m{html} ) {
176     warn "# return only $self body ", $self->content_type;
177     return $body
178     } elsif ( ! defined $body ) {
179     warn "# no body";
180     $body = '<!-- no body -->';
181     }
182 dpavlin 448
183 dpavlin 468 $status_line
184     .= qq|<span class="frey-popup">warn<code>|
185     . $self->editor_links( join("", $self->warnings ) )
186     . qq|</code></span>|
187     if $self->warnings;
188    
189 dpavlin 473 my $right =
190     qq|
191     <span class="right">
192     <a href="?reload=$reload_counter"><code>$url</code></a>
193     </span>
194     |;
195    
196 dpavlin 388 my $html = join("\n",
197     qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|,
198     $self->_head_html,
199 dpavlin 418 '<title>' . ( $self->title || $a->{title} || ref($self) ) . '</title>',
200 dpavlin 388 '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">',
201     ( $a->{head} || '' ),
202     qq|
203 dpavlin 448 </head><body>
204     $body
205 dpavlin 388 <div class="frey-status-line">
206     <a href="/">Frey</a> $Frey::VERSION
207     $status_line
208 dpavlin 473 $right
209 dpavlin 210 </div>
210     </body></html>
211 dpavlin 388 |,
212     );
213 dpavlin 100
214 dpavlin 121 warn "## >>> page ",length($html), " bytes\n" if $self->debug;
215 dpavlin 100
216 dpavlin 121 return $html;
217 dpavlin 100 }
218    
219 dpavlin 468 sub editor_links {
220     my ( $self, $error ) = @_;
221    
222     $error =~ s{at\s+(\S+)\s+line\s+(\d+)}
223     {at <a target="editor" href="/editor+$1+$2">$1</a> line $2}gsm;
224    
225     $error =~ s{(via package ")([\w:]+)(")}
226     {$1<a target="editor" href="/editor+$2+1">$2</a>$3}gsm;
227    
228     return $error;
229     }
230    
231 dpavlin 350 sub error {
232 dpavlin 397 my $self = shift;
233     my $error = join(" ", @_);
234 dpavlin 460
235 dpavlin 465 my @backtrace = $self->backtrace;
236     $error .= "\n\t" . join( "\n\t", @backtrace ) if @backtrace;
237 dpavlin 460
238     warn "ERROR: $error\n";
239 dpavlin 468 return
240     qq|<pre class="frey-error">|
241     . $self->editor_links( $error ) .
242     qq|</pre>|
243     ;
244 dpavlin 350 }
245    
246 dpavlin 100 1;

  ViewVC Help
Powered by ViewVC 1.1.26