--- trunk/lib/Frey/Web.pm 2008/11/28 13:25:17 584 +++ trunk/lib/Frey/Web.pm 2008/11/28 23:34:26 611 @@ -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,10 +100,12 @@ $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|; + } elsif ( $name =~ s{^\s*($name $content\n|; } @@ -119,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; @@ -214,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 @@ -300,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; @@ -459,10 +469,23 @@ $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; @@ -470,6 +493,8 @@ 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"; @@ -486,27 +511,49 @@ 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|; + + $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 ] || '' } 1 .. $max + ); + + 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|| ; } @@ -534,7 +581,7 @@ push @backtrace, qq|via $package at $path line $line|; } - warn "# backtrace: ", dump( @backtrace ) if @backtrace; + #warn "# backtrace: ", dump( @backtrace ) if @backtrace; return @backtrace; }