174 |
|
|
175 |
} |
} |
176 |
|
|
177 |
sub add_css { |
sub _add_something { |
178 |
my ($self,$css) = @_; |
my ( $self, $regex, $tag, $type, $content ) = @_; |
|
my ( $package, $path, $line ) = caller; |
|
|
$self->add_head( qq| |
|
|
<style type="text/css"> |
|
|
/* via $package at $path line $line */ |
|
|
$css |
|
|
</style> |
|
|
| ); |
|
|
} |
|
179 |
|
|
180 |
sub add_js { |
my ( $package, $path, $line ) = caller(1); |
181 |
my ($self,$js) = @_; |
|
182 |
my ( $package, $path, $line ) = caller; |
warn "# $regex $tag $type $content caller $package $path $line"; |
183 |
|
|
184 |
if ( $js =~ m{http.*\.js} ) { |
if ( $content =~ $regex ) { |
185 |
$self->add_head( qq| |
$content = "/$content" if -e $content; |
186 |
<script type="text/javascript" src="$js"> |
$self->add_head( strip ( qq| |
187 |
|
<$tag type="$type" src="$content"> |
188 |
/* via $package at $path line $line */ |
/* via $package at $path line $line */ |
189 |
</script> |
</$tag> |
190 |
|); |
| ) ); |
191 |
} else { |
} else { |
192 |
$self->add_head( qq| |
$self->add_head(qq| |
193 |
<script type="text/javascript"> |
<$tag type="$type"> |
194 |
/* via $package at $path line $line */ |
/* via $package at $path line $line */ |
195 |
$js |
$content |
196 |
</script> |
</$tag> |
197 |
| ); |
|); |
198 |
}; |
}; |
199 |
} |
} |
200 |
|
|
201 |
|
sub add_css { |
202 |
|
my ($self,$css) = @_; |
203 |
|
$self->_add_something( qr{\.css$}, qw{style text/css}, $css ); |
204 |
|
} |
205 |
|
|
206 |
|
sub add_js { |
207 |
|
my ($self,$js) = @_; |
208 |
|
$self->_add_something( qr{\.js$}, qw{script text/javascript}, $js ); |
209 |
|
} |
210 |
|
|
211 |
our $reload_counter = 0; |
our $reload_counter = 0; |
212 |
|
|
213 |
|
|
249 |
if ( ! $body ) { |
if ( ! $body ) { |
250 |
my $run = $a->{run} || 'as_markup'; |
my $run = $a->{run} || 'as_markup'; |
251 |
warn "# no body, invoke $self->$run on ", ref($self); |
warn "# no body, invoke $self->$run on ", ref($self); |
252 |
eval { |
$body = $self->$run; |
|
$body = $self->$run; |
|
|
}; |
|
|
$body = $self->error( $@, '' ) if $@; |
|
253 |
} |
} |
254 |
if ( $self->content_type !~ m{html} ) { |
if ( $self->content_type !~ m{html} ) { |
255 |
warn "# return only $self body ", $self->content_type; |
warn "# return only $self body ", $self->content_type; |
365 |
return $error; |
return $error; |
366 |
} |
} |
367 |
|
|
368 |
|
sub html_self { |
369 |
|
my $self = shift; |
370 |
|
my $html = $self; |
371 |
|
$html =~ s{([\w:]+)=}{<a target="$1" href="/$1" title="introspect $1">$1</a>=}gsm; |
372 |
|
return $html; |
373 |
|
} |
374 |
|
|
375 |
=head2 error |
=head2 error |
376 |
|
|
377 |
This method will return error to browser and backtrace unless |
This method will return error to browser and backtrace unless |
384 |
my $error = join(" ", @_); |
my $error = join(" ", @_); |
385 |
|
|
386 |
my $fatal = ''; |
my $fatal = ''; |
387 |
|
my $backtrace = ''; |
388 |
|
|
389 |
if ( $error !~ m{\n$} ) { |
if ( $error !~ m{\n$} ) { |
390 |
if ( my @backtrace = $self->backtrace ) { |
if ( my @backtrace = $self->backtrace ) { |
391 |
$error .= "\n\t" . join( "\n\t", @backtrace ); |
$backtrace = |
392 |
|
"\n" . $self->html_self . "->error backtrace\n\t" |
393 |
|
. $self->html_links( join( "\n\t", @backtrace ) ) |
394 |
|
; |
395 |
$fatal = qq| frey-fatal|; |
$fatal = qq| frey-fatal|; |
396 |
} |
} |
397 |
} |
} |
398 |
|
|
399 |
warn "ERROR: $error\n"; |
warn "ERROR: $error\n"; |
400 |
return |
$self->add_icon('error'); |
401 |
qq|<pre class="frey-error$fatal">| |
$error = $self->html_links( $error ); |
402 |
. $self->html_links( $error ) . |
return qq|<pre class="frey-error$fatal">$error $backtrace</pre>| ; |
|
qq|</pre>| |
|
|
; |
|
403 |
} |
} |
404 |
|
|
405 |
=head1 Status line |
=head1 Status line |
475 |
|
|
476 |
sub icon_path { |
sub icon_path { |
477 |
my ($self,$class,$variant) = @_; |
my ($self,$class,$variant) = @_; |
|
# $class ||= $self->title; |
|
478 |
|
|
479 |
sub icon_exists { |
sub icon_exists { |
480 |
my $class = shift; |
my $class = shift; |
505 |
sub add_icon { |
sub add_icon { |
506 |
my ($self,$variant) = @_; |
my ($self,$variant) = @_; |
507 |
|
|
508 |
my $class = ref($self); |
my $class = $self->class if $self->can('class'); |
509 |
$class = $self->class if $self->can('class'); |
#$class ||= $self->title; |
510 |
|
$class ||= ref($self); |
511 |
my $icon_path = $self->icon_path( $class, $variant ) || return; |
my $icon_path = $self->icon_path( $class, $variant ) || return; |
512 |
|
|
513 |
$icon_html .= qq|<link rel="icon" type="image/png" href="/$icon_path">|; |
$icon_html .= qq|<link rel="icon" type="image/png" href="/$icon_path">|; |
678 |
my ($self) = @_; |
my ($self) = @_; |
679 |
|
|
680 |
my @backtrace; |
my @backtrace; |
681 |
foreach ( 0 .. 5 ) { |
foreach ( 1 .. 5 ) { # 0 = backtrace |
682 |
my ( |
my ( |
683 |
$package,$path,$line |
$package,$path,$line |
684 |
# subroutine hasargs |
# subroutine hasargs |