--- trunk/lib/Frey/Web.pm 2009/01/06 16:05:05 949
+++ trunk/lib/Frey/Web.pm 2009/06/29 16:54:02 1109
@@ -2,12 +2,13 @@
use Moose::Role;
with 'Frey::Session';
+with 'Frey::Class::Icon';
-#use Continuity::Widget::DomNode;
use Data::Dump qw/dump/;
use Carp qw/confess cluck carp/;
use File::Slurp;
use Text::Tabs; # expand, unexpand
+use Digest::MD5 qw/md5/;
use lib 'lib';
@@ -71,11 +72,19 @@
default => 250,
);
+has 'wrap_in_page' => (
+ documentation => 'wrap full html page with status bar around content',
+ is => 'rw',
+ isa => 'Bool',
+ default => 1,
+);
+
my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"');
my $escape_re = join '|' => keys %escape;
sub html_escape {
my ( $self, $html ) = @_;
+ return '' unless defined $html;
$html =~ s/($escape_re)/$escape{$1}/g;
return $html;
}
@@ -189,6 +198,9 @@
sub _add_css_js {
my ( $self, $what, $content ) = @_;
+ my $md5 = md5( $content );
+ return if $self->{_add_css_js_seen}->{$what}->{$md5}++;
+
my $tag = $what eq 'css' ? 'style' : 'script';
my $type = $what eq 'css' ? 'text/css' : 'text/javascript';
my $head;
@@ -196,7 +208,7 @@
my ( $package, $path, $line ) = caller(1);
$content = "/$content" if $content !~ m{[\n\r]} && -e $content;
- if ( $content =~ $re_html ) {
+ if ( $content =~ $re_html && $what ne 'js' ) {
$head = qq|
$content
@@ -238,9 +250,9 @@
our $reload_counter = 0;
-=head2 page
+=head2 html_page
- $self->page(
+ $self->html_page(
title => 'page title',
head => '',
body => 'Page Body',
@@ -251,9 +263,7 @@
our @status;
sub status { @status };
-our $icon_html;
-
-sub page {
+sub html_page {
my $self = shift;
my $a = {@_};
@@ -276,7 +286,7 @@
warn "# no body, invoke $self->$run on ", ref($self);
$body = $self->$run;
}
- if ( $self->content_type !~ m{html} ) {
+ if ( $self->content_type !~ m{html} || ! $self->wrap_in_page ) {
warn "# return only $self body ", $self->content_type;
return $body
} elsif ( ! defined $body ) {
@@ -292,7 +302,7 @@
my $right =
qq|
-
+
reload
$exit
@@ -303,7 +313,7 @@
my $revision = $svk->info->{Revision} || '';
$revision = $1 if $info->{'Mirrored From'} =~ m{Rev\.\s+(\d+)};
- $self->add_icon unless $icon_html;
+ $self->add_icon;
my $title = undef
|| $a->{title}
@@ -313,12 +323,18 @@
# $title =~ s{(\w)\w+::}{$1:}g; # XXX compress names of classes
+ $self->add_css(qq|
+ body {
+ padding-bottom: 3em; /* don't overlap status line */
+ }
+ |);
+
my $html = join("\n",
qq||,
$self->_head_html,
qq|$title|,
'',
- ( $icon_html || '' ),
+ ( $self->icon_html ),
( $a->{head} || '' ),
qq|
@@ -469,13 +485,13 @@
sub clean_status {
my ($self) = shift;
+ warn "## clean_status";
@head = ( 'static/frey.css' );
@status = (
{ 'ClassBrowser' => Frey::Class::Browser->new( usage_sort => 1, usage_on_top => 0 )->as_markup },
{ 'Bookmarklets' => Frey::Bookmarklet->new->as_markup },
- { 'INC' => Frey::INC->new->as_markup },
+ { 'INC' => Frey::INC->new->as_markup },
);
- $icon_html = '';
}
=head2 status_parts
@@ -499,68 +515,6 @@
=cut
-=head2 add_icon
-
- Frey::Foo->add_icon; # /static/icons/Frey/Foo.png
- Frey::Foo->add_icon('warning'); # /static/icons/Frey/Foo/warning.png
-
-=cut
-
-sub icon_path {
- my ($self,$class,$variant) = @_;
-
- sub icon_exists {
- my $class = shift;
- $class =~ s{::}{/}g;
- $class .= "/$variant" if $variant;
- my $icon_path = 'static/icons/' . $class . '.png';
- return $icon_path if -e $icon_path;
- return;
- }
-
- my $path = icon_exists( $class );
- if ( ! $path ) {
- my $super_class = $class;
- while ( $super_class =~ s{::[^:]+$}{} && ! $path ) {
- $path = icon_exists( $super_class ) unless $super_class eq 'Frey'; # don't default on Frey icon
- }
- }
-
- if ( ! $path ) {
- $self->TODO( "add icon for $class" . ( $variant ? " variant $variant" : '' ) );
- return undef;
- }
-
- warn "# $class from $self icon_path $path" if $self->debug;
- return $path;
-}
-
-sub add_icon {
- my ($self,$variant) = @_;
-
- my $class = $self->class if $self->can('class');
- #$class ||= $self->title;
- $class ||= ref($self);
- my $icon_path = $self->icon_path( $class, $variant ) || return;
-
- $icon_html .= qq||;
- warn "# using icon $icon_path";
-
-=for later
-
- # FIXME http://en.wikipedia.org/wiki/Favicon suggest just rel="icon" but that doesn't seem to work!
- my $ico_path = $icon_path;
- $ico_path =~ s{png$}{ico};
- if ( ! -e $ico_path ) {
- system "convert $icon_path $ico_path";
- warn "# convert $icon_path $ico_path : $@";
- }
- $icon_html .= qq|| if -e $ico_path;
-
-=cut
-
-}
-
my $warn_colors = {
'#' => '#444',
'##' => '#888',