--- trunk/lib/Frey/Web.pm 2008/11/28 17:20:05 596 +++ trunk/lib/Frey/Web.pm 2008/12/02 01:49:49 674 @@ -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; @@ -16,13 +16,19 @@ use Frey::SVK; +use Text::Tabs; # expand, unexpand + our @head; sub head { @head } has 'request_url' => ( is => 'rw', isa => 'Uri', coerce => 1, - default => '/', + required => 1, + default => sub { + carp "undefined request_url"; + '/'; + }, ); has 'title' => ( @@ -61,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 = ('<'=>'<', '>'=>'>', '&'=>'&', '"'=>'"'); @@ -121,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; @@ -218,8 +224,11 @@ my $body = $a->{body}; if ( ! $body ) { my $run = $a->{run} || 'as_markup'; - warn "# no body, invoke $self->$run"; - $body = $self->$run; + warn "# no body, invoke $self->$run on ", ref($self); + eval { + $body = $self->$run; + }; + $body = $self->error( $@, '' ) if $@; } if ( $self->content_type !~ m{html} ) { warn "# return only $self body ", $self->content_type; @@ -239,7 +248,7 @@ qq| reload - $exit + $exit |; @@ -308,25 +317,47 @@ # $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; - $error =~ s{(via (?:package) "?)([\w:]+)("?)} - {$1$2$3}gsm; + $error =~ s{(via (?:package)\s+"?)([\w:]+)("?)} + {$1$2$3}gsm; + + # method error messages +# $error =~ s{(method ")(\w+)"} +# {$1$2"}gsm; # FIXME replace with link to Frey::Introspect data + + # anything that looks like "Class::Name" + $error =~ s{"(\w+(?:::\w+)+)"} + {"$1"}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| class="fatal"|; + } + } warn "ERROR: $error\n"; return - qq|
|
+		qq|
|
 		. $self->editor_links( $error ) .
 		qq|
| ; @@ -370,7 +401,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 = ''; } @@ -455,29 +486,53 @@ '"' => '"', }; +=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 $last_log_pos = 0; +our $last_log_line = 0; + +our $pwd = `pwd`; +chomp $pwd; + sub warnings_html { my ($self,$level) = shift; $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 $line = $last_log_line; my $multiline_end; - open(my $log, '<', $path) || die "can't open $path: $!"; + # 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: $!"; + 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 @@ -499,42 +554,56 @@ } =cut - if ( m{^(#*)\s+} ) { # FIXME + if ( m{^(#*)} ) { - $style = $warn_colors->{$1} - ? ' style="color:' . $warn_colors->{$1} . '"' - : ''; + my $level = $1; + my $msg = $_; + + # Mojo seems to expand warn messages to full path which is annoying + $msg =~ s{/[^/]+/\.\./}{/}gs; + $msg =~ s{$pwd/*}{}gs; - 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;
 		}
 	}
+	$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;
 
-	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 )
-		. qq||
+		. $self->editor_links( $warnings )
+		. qq||
 		;
 }
 
@@ -560,7 +629,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;