--- trunk/lib/Frey/Web.pm 2008/11/28 00:30:03 577 +++ trunk/lib/Frey/Web.pm 2008/11/30 14:02:35 634 @@ -16,12 +16,19 @@ use Frey::SVK; -our @head = ( 'static/frey.css' ); +use Text::Tabs; # expand, unexpand + +our @head; +sub head { @head } has 'request_url' => ( is => 'rw', isa => 'Uri', coerce => 1, - default => '/', + required => 1, + default => sub { + cluck "undefined request_url"; + '/'; + }, ); has 'title' => ( @@ -60,7 +67,7 @@ is => 'rw', isa => 'Int', # required => 1, # FIXME we can't have required fields with defaults because Frey::Action isn't smart enough and asks for them - default => 128, + default => 250, ); my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -79,13 +86,14 @@ $dump =~ s{(\n[^\n]{$width})([^\n]+?)([^\n]{5})}{\n$1...$3}gs; $dump = $self->html_escape( $dump ); $dump =~ s{\Q...\E}{…}gs; +# $dump =~ $self->editor_links( $dump ); # FIXME include this return "$dump"; } 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+).+?/\1|[^>]+/)>}s; # relaxed html check for one semi-valid tag sub popup_dropdown { my ( $self, $type, $name, $content, $full ) = @_; @@ -94,10 +102,14 @@ $content = qq|$content| unless $content =~ m{^\s*<(span|a|code).+?/\1>\s*}; - warn "## $type [$name] = ", length( $content ), " bytes" if $self->debug; + $content =~ s{([^<]+)}{$1} && $self->TODO("code wrapped in span"); + + warn "## $type [$name] = ", length( $content ), " bytes"; # if $self->debug; # FIXME if ( $name =~ m{::} && $name !~ $re_html ) { return qq|$name $content\n|; + } elsif ( $name =~ s{^\s*($name $content\n|; } @@ -115,11 +127,11 @@ $path =~ s!^/!!; if ( $path =~ m/\.js$/ ) { $out .= $self->_inline_path( $path ) ? - qq|| : + qq|| : qq||; } elsif ( $path =~ m/\.css$/ ) { $out .= $self->_inline_path( $path ) ? - qq|| : + qq|| : qq||; } elsif ( $path =~ m{<.+>}s ) { $out .= $path; @@ -166,7 +178,7 @@ my ( $package, $path, $line ) = caller; $self->add_head( qq| | ); @@ -200,10 +212,6 @@ my $status_line = ''; - unshift @status, { 'ClassBrowser' => Frey::ClassBrowser->new( usage_on_top => 0 )->as_markup }; -# unshift @status, { 'Bookmarklets' => Frey::Bookmarklet->new->as_markup }; - unshift @status, { 'INC' => Frey::INC->new->as_markup }; - foreach my $part ( @status ) { foreach my $name ( keys %$part ) { $status_line .= $self->popup( $name, $part->{$name} ); @@ -214,7 +222,11 @@ $url =~ s{\?reload=\d+}{}; my $body = $a->{body}; - $body ||= $self->as_markup if $self->can('as_markup'); + if ( ! $body ) { + my $run = $a->{run} || 'as_markup'; + warn "# no body, invoke $self->$run on ", ref($self); + $body = $self->$run; + } if ( $self->content_type !~ m{html} ) { warn "# return only $self body ", $self->content_type; return $body @@ -300,10 +312,12 @@ sub editor_links { my ( $self, $error ) = @_; +# $error =~ s[(bless\({\s+.+?\s+},\s+)("[^"]+")(\) at)][$1$2$3]gs; # FIXME insert bless hiding back + $error =~ s{at\s+(\S+)\s+line\s+(\d+)} {at $1 line $2}gsm; - $error =~ s{(via package ")([\w:]+)(")} + $error =~ s{(via (?:package) "?)([\w:]+)("?)} {$1$2$3}gsm; return $error; @@ -328,7 +342,7 @@ =head2 add_status - $self->add_status( name => { some => 'data' } ); + $self->add_status( { name => { some => 'data' } } ); $self->add_status( "append to last status popup" ); @@ -336,10 +350,15 @@ sub add_status { my ( $self, $data ) = @_; + push @status, { 'X' => [ $self->backtrace ] }; if ( ref($data) ) { push @status, $data; } else { - $status[ $#status ]->{added} = $data; + if ( defined $status[ $#status ] ) { + $status[ $#status ]->{ '+' } = $data; + } else { + push @status, { '+' => $data }; + } } } @@ -353,8 +372,13 @@ sub clean_status { my ($self) = shift; - @head = (); - @status = (); + @head = ( 'static/frey.css' ); + my $params = { request_url => $self->request_url }; + @status = ( + { 'ClassBrowser' => Frey::ClassBrowser->new( %$params, usage_on_top => 0 )->as_markup }, + { 'Bookmarklets' => Frey::Bookmarklet->new( %$params )->as_markup }, + { 'INC' => Frey::INC->new( %$params )->as_markup }, + ); $icon_html = ''; } @@ -442,7 +466,7 @@ warn "## multiline markers ", dump( $multiline_markers ), " -> $multiline_re"; sub log_path { - $Frey::Bootstrap::log_path || warn "no log_path?"; + $Frey::Bootstrap::log_path || die "no log_path?"; } sub warnings_html { @@ -450,17 +474,34 @@ $level ||= $self->debug, my $path = $self->log_path; - my $warnings; + my $max = 30; + my $pos = 0; + my @warnings = ( '' x $max ); # XXX circualar buffer for 50 lines my $line = 0; my $multiline_end; + # XXX do we really want to do this every time? + my $css = qq|/* short css classes for levels */\n|; + my $level_to_class; + foreach ( keys %$warn_colors ) { + my $l = length($_); + my $class = 'l' . $l; + $css .= qq|.$class { color: $warn_colors->{$_} }\n|; + $level_to_class->{ $_ } = $class; + } + $self->add_css( $css ); + open(my $log, '<', $path) || die "can't open $path: $!"; while(<$log>) { chomp; $line++; + next if m{^\s+(Mojo|Class::MOP|Moose)::}; + my $style = ''; +=for filter + if ( $multiline_end ) { if ( m{^\Q$multiline_end\E} || m{^\s.+\Q$multiline_end\E;$} ) { # warn "## $line end of $multiline_end in '$_'\n"; @@ -477,27 +518,51 @@ next; } - $style = $warn_colors->{$1} - ? ' style="color:' . $warn_colors->{$1} . '"' - : ''; +=cut + if ( m{^(#*)} ) { + + my $level = $1; + my $msg = $_; - my $msg = $self->html_escape( $_ ); my $spacer = ' '; - if ( length($msg) > $self->html_dump_width ) { - $msg = substr( $msg, 0, $self->html_dump_width ); + my $real_msg = expand( $msg ); + if ( length($real_msg) > $self->html_dump_width ) { + + $real_msg = substr( $msg, 0, $self->html_dump_width ); + $msg = unexpand( $real_msg ); $spacer = '…' } - $msg =~ s{^\s}{ }g; - $warnings .= qq|$msg$spacer+$line
|; - # FIXME should be but CSS hates me + + $msg = $self->html_escape( $msg ); + + if ( my $class = $level_to_class->{ $level } ) { + $msg = qq|$msg|; + } + + #$msg .= $spacer . qq|$line\n|; + $msg = qq|$line$msg| + . ( $spacer ? $spacer : '' ) + . "\n"; # XXX
 needs this
+
+			$warnings[ $pos++ % $max ] = $msg;
 		}
 	}
+	warn "log has $line lines tell position ",tell($log);
 	close($log) || die "can't close $path: $!";
 
+	my $size = -s $path;
+
+	my $warnings = join("",
+		map { $warnings[ ( $pos + $_ ) % $max ] || '' } 0 .. ( $max - 1 )
+	);
+
+	my $s = length($warnings);
+
 	return
-		  qq|warn|
+		# need to wrap editor link into span so we can have links in warnings
+		  qq|warn|
 		. $self->editor_links( $warnings )
-		. qq||
+		. qq||
 		;
 }
 
@@ -523,9 +588,9 @@
 		) = caller($_) or last;
 
 		push @backtrace,
-			qq|via package $package at $path line $line|;
+			qq|via $package at $path line $line|;
 	}
-	warn "# backtrace: ", dump( @backtrace ) if @backtrace;
+	#warn "# backtrace: ", dump( @backtrace ) if @backtrace;
 	return @backtrace;
 }