--- trunk/lib/Frey/Web.pm	2008/11/18 12:02:57	407
+++ trunk/lib/Frey/Web.pm	2008/11/20 15:23:13	482
@@ -1,7 +1,7 @@
 package Frey::Web;
 use Moose::Role;
 
-#with 'Frey::Escape';
+with 'Frey::Backtrace';
 
 use Frey::Types;
 
@@ -10,6 +10,9 @@
 use Carp qw/confess/;
 use File::Slurp;
 
+use Frey::Bookmarklet;
+use Frey::ClassBrowser;
+
 has 'head' => (
 	is => 'rw',
 	isa => 'ArrayRef[Str]',
@@ -21,8 +24,8 @@
 	isa => 'ArrayRef[HashRef[Str]]',
 	lazy => 1,
 	default => sub { [
-		{ 'Bookmarklets' => Frey::Bookmarklet->markup },
-		{ 'ClassBrowser' => Frey::ClassBrowser->markup },
+		{ 'ClassBrowser' => Frey::ClassBrowser->new( usage_on_top => 0 )->as_markup },
+		{ 'Bookmarklets' => Frey::Bookmarklet->new->as_markup },
 	] },
 );
 
@@ -32,6 +35,30 @@
 	default => '/',
 );
 
+has 'title' => (
+	is => 'rw',
+	isa => 'Str',
+	lazy => 1,
+	default => sub {
+		my ($self) = @_;
+		ref($self);
+	},
+);
+
+has 'content_type' => (
+	is => 'rw',
+	isa => 'Str',
+	default => 'text/html',
+	documentation => 'Content-type header',
+);
+
+has 'dump_max_bytes' => (
+	is => 'rw',
+	isa => 'Int',
+	default => 4096,
+	documentation => 'Maximum dump size sent to browser before truncation',
+);
+
 =head2 inline_smaller_than
 
 Inline JavaScript and CSS smaller than this size into page reducing
@@ -68,6 +95,8 @@
 			$out .= $self->_inline_path( $path ) ?
 				qq|<!-- $path --><style type="text/css">\n| . read_file( $path ) . qq|\n</style>| :
 				qq|<link type="text/css" rel="stylesheet" href="/$path" media="screen">|;
+		} elsif ( $path =~ m{<.+>}s ) {
+			$out .= $path;
 		} else {
 			confess "don't know how to render $path";
 		}
@@ -82,6 +111,8 @@
 
   my $size = $o->add_head( 'path/to/external.css' );
 
+  $o->add_head( '<!-- html content -->' );
+
 =cut
 
 sub add_head {
@@ -89,17 +120,19 @@
 	return if ! defined $path || $path eq '';
 	$path =~ s!^/!!;
 
-	if ( -e $path ) {
+	if ( $path =~ m{<.*>}s ) {
+		push @{ $self->head }, $path;
+	} elsif ( -e $path ) {
 		if ( $path =~ m/\.(?:js|css)$/ ) {
 			push @{ $self->head }, $path;
 		} else {
 			confess "can't add_head( $path ) it's not js or css";
 		}
+		return -s $path;
 	} else {
 		confess "can't find $path: $!";
 	}
 
-	return -s $path;
 }
 
 our $reload_counter = 0;
@@ -115,9 +148,6 @@
 
 =cut
 
-use Frey::Bookmarklet;
-use Frey::ClassBrowser;
-
 sub page {
 	my $self = shift;
 	my $a = {@_};
@@ -126,13 +156,17 @@
 
 	my $status_line = '';
 	foreach my $part ( @{ $self->status } ) {
-		confess "part not hash ",dump( $part ) unless ref($part) eq 'HASH';
+		if ( ref($part) ne 'HASH' ) {
+			warn "part not hash ",dump( $part ) ;
+			#$self->status( $part );
+			next;
+		}
 		foreach my $name ( keys %$part ) {
 			my $content = $part->{$name};
 			if ( ref($content) ) {
 				$content = '<code>' . dump($content) . '</code>';
 				my $l = length($content);
-				$content = qq|<span>$l bytes</span>| if $l > 1024;
+				$content = qq|<span>$l bytes</span>| if $l > $self->dump_max_bytes;
 			} else {
 				$content = qq|<span>$content</span>|;
 			}
@@ -141,19 +175,65 @@
 		}
 	}
 
+	my $url = $self->request_url;
+	$url =~ s{\?reload=\d+}{};
+
+	my $body = $a->{body};
+	$body ||= $self->as_markup if $self->can('as_markup');
+	if ( $self->content_type !~ m{html} ) {
+		warn "# return only $self body ", $self->content_type;
+		return $body
+	} elsif ( ! defined $body ) {
+		warn "# no body";
+		$body = '<!-- no body -->';
+	}
+
+	my $warn_colors = {
+		'#'  => '#444',
+		'##' => '#888',
+	};
+
+	$status_line
+		.= qq|<span class="frey-popup">warn<span>|
+		. $self->editor_links(
+			join("", map {
+				warn "# $_";
+				my $style = '';
+				$style = $warn_colors->{$1}
+					? ' style="color:' . $warn_colors->{$1} . '"'
+					: ''
+					if m{^(#+)};
+				qq|<tt$style>$_</tt><br/>|; # XXX <tt> should be <code> but CSS hates me
+			} $self->warnings )
+		)
+		. qq|</span></span>|
+		if $self->warnings;
+
+	my	($exit,$description) = ('exit','stop server');
+		($exit,$description) = ('restart','restart server')
+		if $ENV{FREY_RESTART}; # tune labels on exit link
+
+	my $right =
+		qq|
+			<span class="right">
+			<a title="reload"  href="/reload$url"><code>$url</code></a>
+			<a title="$description" href="/exit$url">$exit</a>
+			</span>
+		|;
+
 	my $html = join("\n",
 		qq|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN"><html><head>|,
 		$self->_head_html,
-		'<title>' . ( $a->{title} || ref($self) ) . '</title>',
+		'<title>' . ( $self->title || $a->{title} || ref($self) ) . '</title>',
 		'<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">',
 		( $a->{head} || '' ),
-		'</head><body>',
-		( $a->{body} || '<!-- no body -->' ),
 		qq|
+		</head><body>
+		$body
 		<div class="frey-status-line">
 			<a href="/">Frey</a> $Frey::VERSION
-			<a href="?reload=$reload_counter"><code>| . $self->request_url . qq|</code></a>
 			$status_line
+			$right
 		</div>
 	    </body></html>
 		|,
@@ -164,14 +244,56 @@
 	return $html;
 }
 
+=head2 editor
+
+Create HTML editor link with optional line and title
+
+  my $html = $self->editor( $class, $line, $title );
+
+=cut
+
+sub editor {
+	my ( $self, $class, $line, $title ) = @_;
+	confess "need class" unless $class;
+	$line ||= 1;
+	qq|<a target="editor" href="/editor+$class+$line"| .
+	( $title ? qq| title="$title"| : '' ) .
+	qq|>$class</a>|;
+}
+
+=head2 editor_links
+
+Create HTML links to editor for perl error message
+
+  my $html = $self->editor_links( $error )
+
+=cut
+
+sub editor_links {
+	my ( $self, $error ) = @_;
+
+	$error =~ s{at\s+(\S+)\s+line\s+(\d+)}
+		{at <a target="editor" href="/editor+$1+$2">$1</a> line $2}gsm;
+
+	$error =~ s{(via package ")([\w:]+)(")}
+		{$1<a target="editor" href="/editor+$2+1">$2</a>$3}gsm;
+
+	return $error;
+}
+
 sub error {
 	my $self = shift;
 	my $error = join(" ", @_);
-	my ($package, $filename, $line) = caller;
-	$error .= " at $filename line $line" if $error !~ m{ at };
-	warn "WARN: $error\n";
-	$error =~ s{at\s+(\S+)\s+line\s+(\d+)}{at <a target="editor" href="/editor+$1+$2">$1</a> line $2}gsm;
-	return qq|<pre class="frey-error">$error</pre>|;
+
+	my @backtrace = $self->backtrace;
+	$error .= "\n\t" . join( "\n\t", @backtrace ) if @backtrace;
+
+	warn "ERROR: $error\n";
+	return
+		qq|<pre class="frey-error">|
+		. $self->editor_links( $error ) .
+		qq|</pre>|
+		;
 }
 
 1;