--- trunk/lib/Frey/Web.pm 2008/12/14 14:13:35 835 +++ trunk/lib/Frey/Web.pm 2008/12/24 21:32:14 892 @@ -94,7 +94,7 @@ sub popup { my $self = shift; $self->popup_dropdown('popup', @_); } sub dropdown { my $self = shift; $self->popup_dropdown('dropdown', @_); } -our $re_html = qr{<(?:!--.+?--|(\w+).+?/\1|[^>]+/?)>}s; # relaxed html check for one semi-valid tag +our $re_html = qr{<(?:!--|(\w+)|[^>]+)/?>}s; # relaxed html check for one semi-valid tag sub popup_dropdown { my ( $self, $type, $name, $content, $full ) = @_; @@ -116,9 +116,11 @@ } } -sub _inline_path { +sub _inline { my ( $self, $path ) = @_; - -s $path < $self->inline_smaller_than; + return unless defined $path; + warn "# _inline $path"; + -e $path && -s $path < $self->inline_smaller_than && -s $path; } sub _head_html { @@ -127,12 +129,14 @@ foreach my $path ( @head ) { $path =~ s!^/!!; if ( $path =~ m/\.js$/ ) { - $out .= $self->_inline_path( $path ) ? - qq|| : + my $size; + $out .= $size = _inline( $path ) ? + qq|| : qq||; } elsif ( $path =~ m/\.css$/ ) { - $out .= $self->_inline_path( $path ) ? - qq|| : + my $size; + $out .= $size = _inline( $path ) ? + qq|| : qq||; } elsif ( $path =~ m{<.+>}s ) { $out .= $path; @@ -174,35 +178,53 @@ } +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 ( $content =~ $re_html ) { + $head = qq| + $content + + |; + } elsif ( $what eq 'js' ) { + $head = qq| + <$tag type="$type" src="$content"> + /* $what 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; @@ -227,8 +249,6 @@ my $self = shift; my $a = {@_}; - warn "## page ",dump($a); - $reload_counter++; my $status_line = ''; @@ -362,6 +382,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 +401,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 +695,7 @@ my ($self) = @_; my @backtrace; - foreach ( 0 .. 5 ) { + foreach ( 1 .. 5 ) { # 0 = backtrace my ( $package,$path,$line # subroutine hasargs