--- trunk/lib/Frey/Web.pm 2008/11/29 00:06:11 613 +++ trunk/lib/Frey/Web.pm 2008/12/02 18:29:01 685 @@ -7,7 +7,7 @@ #use Continuity::Widget::DomNode; use Data::Dump qw/dump/; -use Carp qw/confess cluck/; +use Carp qw/confess cluck carp/; use File::Slurp; use Frey::Bookmarklet; @@ -24,7 +24,11 @@ has 'request_url' => ( is => 'rw', isa => 'Uri', coerce => 1, - default => '/', + required => 1, + default => sub { + carp "undefined request_url"; + '/'; + }, ); has 'title' => ( @@ -63,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 => 120, + default => 250, ); my %escape = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -82,7 +86,7 @@ $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 +# $dump =~ $self->html_links( $dump ); # FIXME include this return "$dump"; } @@ -221,7 +225,10 @@ if ( ! $body ) { my $run = $a->{run} || 'as_markup'; warn "# no body, invoke $self->$run on ", ref($self); - $body = $self->$run; + eval { + $body = $self->$run; + }; + $body = $self->error( $@, '' ) if $@; } if ( $self->content_type !~ m{html} ) { warn "# return only $self body ", $self->content_type; @@ -241,7 +248,7 @@ qq| reload - $exit + $exit |; @@ -297,39 +304,70 @@ qq|>$class|; } -=head2 editor_links +=head2 html_links Create HTML links to editor for perl error message - my $html = $self->editor_links( $error ) + my $html = $self->html_links( $error ) =cut -sub editor_links { +sub html_links { my ( $self, $error ) = @_; + $error = $self->strip_full_path( $error ); + # $error =~ s[(bless\({\s+.+?\s+},\s+)("[^"]+")(\) at)][$1$2$3]gs; # FIXME insert bless hiding back + # perl's backtrace $error =~ s{at\s+(\S+)\s+line\s+(\d+)} - {at $1 line $2}gsm; + {at $1 line $2}gsm; - $error =~ s{(via (?:package) "?)([\w:]+)("?)} - {$1$2$3}gsm; + $error =~ s{(via (?:package)\s+"?)([\w:]+)("?)} + {$1$2$3}gsm + || # or anything that looks like "Class::Name" + $error =~ s{"(\w+(?:::\w+)+)"} + {"$1"}gsm; + + # method error messages + # FIXME replace with link to Frey::Introspect data + $error =~ s{(method ")(\w+)(" via)} + {$1$2$3}gsm; + + # link paths to editor + $error =~ s{((?:lib|t)/[\S]+)\s+(\d+\s+bytes)} + {$1}gsm; + + $error =~ s{(class ")([\w:]+)(")} + {$1$2$3}gsm; return $error; } +=head2 error + +This method will return error to browser and backtrace unless +error message ends with LF C<\n> just like L + +=cut + sub error { my $self = shift; my $error = join(" ", @_); - my @backtrace = $self->backtrace; - $error .= "\n\t" . join( "\n\t", @backtrace ) if @backtrace; + my $fatal = ''; + + if ( $error !~ m{\n$} ) { + if ( my @backtrace = $self->backtrace ) { + $error .= "\n\t" . join( "\n\t", @backtrace ); + $fatal = qq| frey-fatal|; + } + } warn "ERROR: $error\n"; return - qq|
|
-		. $self->editor_links( $error ) .
+		qq|
|
+		. $self->html_links( $error ) .
 		qq|
| ; } @@ -372,7 +410,7 @@ @status = ( { 'ClassBrowser' => Frey::ClassBrowser->new( 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 = ''; } @@ -457,13 +495,31 @@ '"' => '"', }; +=for later + my $multiline_re = '[\\' . join('\\', keys %$multiline_markers ) . ']'; warn "## multiline markers ", dump( $multiline_markers ), " -> $multiline_re"; +=cut + sub log_path { - $Frey::Bootstrap::log_path || warn "no log_path?"; + $Frey::Bootstrap::log_path || die "no log_path?"; } +our $pwd = `pwd`; +chomp $pwd; + +sub strip_full_path { + my ($self, $msg) = @_; + # Mojo seems to expand warn messages to full path which is annoying + $msg =~ s{/[^/]+/\.\./}{/}gs; + $msg =~ s{$pwd/*}{}gs; + return $msg; +} + +our $last_log_pos = 0; +our $last_log_line = 0; + sub warnings_html { my ($self,$level) = shift; $level ||= $self->debug, @@ -472,7 +528,7 @@ my $max = 30; my $pos = 0; my @warnings = ( '' x $max ); # XXX circualar buffer for 50 lines - my $line = 0; + my $line = $last_log_line; my $multiline_end; # XXX do we really want to do this every time? @@ -486,11 +542,14 @@ } $self->add_css( $css ); - open(my $log, '<', $path) || die "can't open $path: $!"; + open(my $log, '<', $path) || die "can't open $path: $!"; + seek($log, $last_log_pos, 0) || warn "can't seek: $!"; while(<$log>) { chomp; $line++; + next if m{^\s+(Mojo|Class::MOP|Moose)::}; + my $style = ''; =for filter @@ -515,7 +574,7 @@ if ( m{^(#*)} ) { my $level = $1; - my $msg = $_; + my $msg = $self->strip_full_path( $_ ); my $spacer = ' '; my $real_msg = expand( $msg ); @@ -540,7 +599,9 @@ $warnings[ $pos++ % $max ] = $msg; } } - warn "log has $line lines tell position ",tell($log); + $last_log_pos = tell($log); + $last_log_line = $line; + warn "log has $line lines tell position $last_log_pos"; close($log) || die "can't close $path: $!"; my $size = -s $path; @@ -554,8 +615,8 @@ return # need to wrap editor link into span so we can have links in warnings qq|warn| - . $self->editor_links( $warnings ) - . qq|| + . $self->html_links( $warnings ) + . qq|| ; } @@ -581,7 +642,7 @@ ) = caller($_) or last; push @backtrace, - qq|via $package at $path line $line|; + qq|via "$package" at $path line $line|; } #warn "# backtrace: ", dump( @backtrace ) if @backtrace; return @backtrace;