--- trunk/lib/Frey/Web.pm 2008/11/28 15:07:03 588 +++ trunk/lib/Frey/Web.pm 2008/11/29 00:06:11 613 @@ -16,6 +16,8 @@ use Frey::SVK; +use Text::Tabs; # expand, unexpand + our @head; sub head { @head } @@ -61,7 +63,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 => 120, ); my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -87,7 +89,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+).+?/\1|[^>]+/)>}s; # relaxed html check for one semi-valid tag sub popup_dropdown { my ( $self, $type, $name, $content, $full ) = @_; @@ -98,7 +100,7 @@ $content =~ s{([^<]+)}{$1} && $self->TODO("code wrapped in span"); - warn "## $type [$name] = ", length( $content ), " bytes" if $self->debug; + warn "## $type [$name] = ", length( $content ), " bytes"; # if $self->debug; # FIXME if ( $name =~ m{::} && $name !~ $re_html ) { return qq|$name $content\n|; @@ -121,11 +123,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; @@ -216,7 +218,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 @@ -302,6 +308,8 @@ 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; @@ -461,12 +469,23 @@ $level ||= $self->debug, my $path = $self->log_path; - my $max = 50; + 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; @@ -493,41 +512,49 @@ } =cut - if ( m{^(#*)\s+} ) { # FIXME + if ( m{^(#*)} ) { - $style = $warn_colors->{$1} - ? ' style="color:' . $warn_colors->{$1} . '"' - : ''; + 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 = '…' } - $warnings[ $pos++ % $max ] - = $msg -# = ( $style ? qq|$msg| : $msg ) - . $spacer - . qq|+$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
+	my $warnings = join("",
+		map { $warnings[ ( $pos + $_ ) % $max ] || '' } 0 .. ( $max - 1 )
 	);
 
 	my $s = length($warnings);
 
 	return
-		# need to wrap into span so we can have links in warnings
+		# need to wrap editor link into span so we can have links in warnings
 		  qq|warn|
-		. $warnings
-#		. $self->editor_links( $warnings )
+		. $self->editor_links( $warnings )
 		. qq||
 		;
 }
@@ -556,7 +583,7 @@
 		push @backtrace,
 			qq|via $package at $path line $line|;
 	}
-	warn "# backtrace: ", dump( @backtrace ) if @backtrace;
+	#warn "# backtrace: ", dump( @backtrace ) if @backtrace;
 	return @backtrace;
 }