--- trunk/lib/Frey/Web.pm 2008/12/14 15:13:55 837 +++ trunk/lib/Frey/Web.pm 2009/01/06 15:26:19 945 @@ -80,6 +80,14 @@ return $html; } +# from Mojo::ByteStream +sub url_escape { + my ( $self, $url, $pattern ) = @_; + $pattern ||= 'A-Za-z0-9\-\.\_\~'; + $url =~ s/([^$pattern])/sprintf('%%%02X',ord($1))/ge; + return $url; +} + sub html_dump { my ( $self, $dump ) = @_; $dump = dump( $dump ) if ref($dump); @@ -94,7 +102,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 +124,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 +137,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 +186,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); + + $content = "/$content" if $content !~ m{[\n\r]} && -e $content; + if ( $content =~ $re_html ) { + $head = qq| + $content + + |; + } elsif ( $content =~ m{^(/|https?://)} ) { + if ( $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 +257,6 @@ my $self = shift; my $a = {@_}; - warn "## page ",dump($a); - $reload_counter++; my $status_line = ''; @@ -277,10 +305,18 @@ $self->add_icon unless $icon_html; + my $title = undef + || $a->{title} + || $self->title + || ref($self) + ; + +# $title =~ s{(\w)\w+::}{$1:}g; # XXX compress names of classes + my $html = join("\n", qq||, $self->_head_html, - '' . ( $self->title || $a->{title} || ref($self) ) . '', + qq|$title|, '', ( $icon_html || '' ), ( $a->{head} || '' ), @@ -411,8 +447,8 @@ sub add_status { my ( $self, $data ) = @_; - push @status, { 'X' => [ $self->backtrace ] }; - if ( ref($data) ) { + die "no data" unless $data; + if ( ref $data ) { push @status, $data; } else { if ( defined $status[ $#status ] ) {