--- trunk/lib/Frey/Web.pm 2008/12/14 14:13:35 835 +++ trunk/lib/Frey/Web.pm 2008/12/14 22:47:48 839 @@ -174,35 +174,48 @@ } +sub _add_css_js { + my ( $self, $what, $content ) = @_; + + my $tag = $what eq 'css' ? 'style' : 'script'; + my $type = $what eq 'css' ? 'text/css' : 'text/javascript'; + my $head; + + my ( $package, $path, $line ) = caller(1); + + if ( $content =~ m{\.(js|css)} ) { + $content = "/$content" if -e $content; + if ( $what eq 'js' ) { + $head = qq| + <$tag type="$type" src="$content"> + /* via $package at $path line $line */ + + |; + } else { + $head = qq| + + + |; + } + } else { + $head = qq| + <$tag type="$type"> + /* via $package at $path line $line */ + $content + + |; + }; + $self->add_head( $head ); +} + sub add_css { my ($self,$css) = @_; - my ( $package, $path, $line ) = caller; - $self->add_head( qq| - - | ); + $self->_add_css_js( 'css', $css ); } sub add_js { my ($self,$js) = @_; - my ( $package, $path, $line ) = caller; - - if ( $js =~ m{http.*\.js} ) { - $self->add_head( qq| - - |); - } else { - $self->add_head( qq| - - | ); - }; + $self->_add_css_js( 'js', $js ); } our $reload_counter = 0; @@ -362,6 +375,13 @@ return $error; } +sub html_self { + my $self = shift; + my $html = $self; + $html =~ s{([\w:]+)=}{$1=}gsm; + return $html; +} + =head2 error This method will return error to browser and backtrace unless @@ -374,21 +394,22 @@ my $error = join(" ", @_); my $fatal = ''; + my $backtrace = ''; if ( $error !~ m{\n$} ) { if ( my @backtrace = $self->backtrace ) { - $error .= "\n\t" . join( "\n\t", @backtrace ); + $backtrace = + "\n" . $self->html_self . "->error backtrace\n\t" + . $self->html_links( join( "\n\t", @backtrace ) ) + ; $fatal = qq| frey-fatal|; } } warn "ERROR: $error\n"; $self->add_icon('error'); - return - qq|
|
-		. $self->html_links( $error ) .
-		qq|
| - ; + $error = $self->html_links( $error ); + return qq|
$error $backtrace
| ; } =head1 Status line @@ -667,7 +688,7 @@ my ($self) = @_; my @backtrace; - foreach ( 0 .. 5 ) { + foreach ( 1 .. 5 ) { # 0 = backtrace my ( $package,$path,$line # subroutine hasargs