7 |
|
|
8 |
use Continuity::Widget::DomNode; |
use Continuity::Widget::DomNode; |
9 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
10 |
use Carp qw/confess/; |
use Carp qw/confess cluck/; |
11 |
use File::Slurp; |
use File::Slurp; |
12 |
|
|
13 |
use Frey::Bookmarklet; |
use Frey::Bookmarklet; |
14 |
use Frey::ClassBrowser; |
use Frey::ClassBrowser; |
15 |
|
use Frey::SVK; |
16 |
|
|
17 |
has 'head' => ( |
has 'head' => ( |
18 |
is => 'rw', |
is => 'rw', |
25 |
isa => 'ArrayRef[HashRef[Str]]', |
isa => 'ArrayRef[HashRef[Str]]', |
26 |
lazy => 1, |
lazy => 1, |
27 |
default => sub { [ |
default => sub { [ |
28 |
{ 'ClassBrowser' => Frey::ClassBrowser->new( usage_on_top => 0 )->as_markup }, |
# { 'ClassBrowser' => Frey::ClassBrowser->new( usage_on_top => 0 )->as_markup }, |
29 |
{ 'Bookmarklets' => Frey::Bookmarklet->new->as_markup }, |
# { 'Bookmarklets' => Frey::Bookmarklet->new->as_markup }, |
30 |
] }, |
] }, |
31 |
); |
); |
32 |
|
|
157 |
|
|
158 |
my $status_line = ''; |
my $status_line = ''; |
159 |
foreach my $part ( @{ $self->status } ) { |
foreach my $part ( @{ $self->status } ) { |
|
if ( ref($part) ne 'HASH' ) { |
|
|
warn "part not hash ",dump( $part ) ; |
|
|
#$self->status( $part ); |
|
|
next; |
|
|
} |
|
160 |
foreach my $name ( keys %$part ) { |
foreach my $name ( keys %$part ) { |
161 |
my $content = $part->{$name}; |
my $content = $part->{$name}; |
162 |
if ( ref($content) ) { |
if ( ref($content) ) { |
184 |
$body = '<!-- no body -->'; |
$body = '<!-- no body -->'; |
185 |
} |
} |
186 |
|
|
187 |
|
my $warn_colors = { |
188 |
|
'#' => '#444', |
189 |
|
'##' => '#888', |
190 |
|
}; |
191 |
|
|
192 |
$status_line |
$status_line |
193 |
.= qq|<span class="frey-popup">warn<code>| |
.= qq|<span class="frey-popup">warn<span>| |
194 |
. $self->editor_links( join("", $self->warnings ) ) |
. $self->editor_links( |
195 |
. qq|</code></span>| |
join("", map { |
196 |
|
warn "# $_"; |
197 |
|
my $style = ''; |
198 |
|
$style = $warn_colors->{$1} |
199 |
|
? ' style="color:' . $warn_colors->{$1} . '"' |
200 |
|
: '' |
201 |
|
if m{^(#+)}; |
202 |
|
qq|<tt$style>$_</tt><br/>|; # XXX <tt> should be <code> but CSS hates me |
203 |
|
} $self->warnings ) |
204 |
|
) |
205 |
|
. qq|</span></span>| |
206 |
if $self->warnings; |
if $self->warnings; |
207 |
|
|
208 |
|
my ($exit,$description) = ('exit','stop server'); |
209 |
|
($exit,$description) = ('restart','restart server') |
210 |
|
if $ENV{FREY_RESTART}; # tune labels on exit link |
211 |
|
|
212 |
my $right = |
my $right = |
213 |
qq| |
qq| |
214 |
<span class="right"> |
<span class="right"> |
215 |
<a href="?reload=$reload_counter"><code>$url</code></a> |
<a title="reload" href="/reload$url"><code>$url</code></a> |
216 |
|
<a title="$description" href="/exit$url">$exit</a> |
217 |
</span> |
</span> |
218 |
|; |
|; |
219 |
|
|
220 |
|
my $info = Frey::SVK->info; |
221 |
|
my $revision = Frey::SVK->info->{Revision} || ''; |
222 |
|
$revision = $1 if $info->{'Mirrored From'} =~ m{Rev\.\s+(\d+)}; |
223 |
|
|
224 |
my $html = join("\n", |
my $html = join("\n", |
225 |
qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|, |
qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|, |
226 |
$self->_head_html, |
$self->_head_html, |
231 |
</head><body> |
</head><body> |
232 |
$body |
$body |
233 |
<div class="frey-status-line"> |
<div class="frey-status-line"> |
234 |
<a href="/">Frey</a> $Frey::VERSION |
<a href="/">Frey</a> $Frey::VERSION $revision |
235 |
$status_line |
$status_line |
236 |
$right |
$right |
237 |
</div> |
</div> |
244 |
return $html; |
return $html; |
245 |
} |
} |
246 |
|
|
247 |
|
=head2 editor |
248 |
|
|
249 |
|
Create HTML editor link with optional line and title |
250 |
|
|
251 |
|
my $html = $self->editor( $class, $line, $title ); |
252 |
|
|
253 |
|
=cut |
254 |
|
|
255 |
|
sub editor { |
256 |
|
my ( $self, $class, $line, $title ) = @_; |
257 |
|
confess "need class" unless $class; |
258 |
|
$line ||= 1; |
259 |
|
qq|<a target="editor" href="/editor+$class+$line"| . |
260 |
|
( $title ? qq| title="$title"| : '' ) . |
261 |
|
qq|>$class</a>|; |
262 |
|
} |
263 |
|
|
264 |
|
=head2 editor_links |
265 |
|
|
266 |
|
Create HTML links to editor for perl error message |
267 |
|
|
268 |
|
my $html = $self->editor_links( $error ) |
269 |
|
|
270 |
|
=cut |
271 |
|
|
272 |
sub editor_links { |
sub editor_links { |
273 |
my ( $self, $error ) = @_; |
my ( $self, $error ) = @_; |
274 |
|
|
296 |
; |
; |
297 |
} |
} |
298 |
|
|
299 |
|
sub add_status { |
300 |
|
my ( $self, $data ) = @_; |
301 |
|
push @{ $self->status }, $data; |
302 |
|
} |
303 |
|
|
304 |
|
sub DEMOLISH { |
305 |
|
my ( $self ) = @_; |
306 |
|
cluck "## DEMOLISH status ", $#{ $self->status } + 1, " elements ", dump( map { keys %$_ } @{ $self->status } ); |
307 |
|
} |
308 |
|
|
309 |
1; |
1; |