--- trunk/lib/Frey/Pod.pm	2008/11/16 15:49:49	356
+++ trunk/lib/Frey/Pod.pm	2009/02/03 21:24:02	1034
@@ -7,33 +7,35 @@
 
 =cut
 
-extends 'Frey::ClassLoader';
+extends 'Frey::Class::Loader';
 with 'Frey::Web';
+with 'Frey::File';
 
 has 'class' => (
 	is => 'rw',
 	isa => 'Str',
 	required => 1,
+	default => 'Frey::Manual',
 );
 
-use File::Slurp;
-use Data::Dump qw/dump/;
 use Pod::Find qw/pod_where/;
+use Data::Dump qw/dump/;
 
-sub request {
-	my ( $self, $req ) = @_;
-	my $f = { $req->params };
-	my $class = delete( $f->{class} ) || $self->class;
-	$req->print( $self->page( title => $class, body => $self->markup( $class ) ) );
-}
+=head2 as_markup
 
-sub markup {
+ my $html = $o->as_markup;
+
+ my ( $toc_html, $html ) = $o->as_markup;
+
+=cut
+
+sub as_markup {
 	my $self = shift;
 	my $class = $self->class;
 	use Pod::Simple::HTML;
 	my $path = pod_where( { -inc => 1 }, $class );
-	return $self->error( "Can't find pod for $class" ) unless $path;
-	my $pod = read_file( $path );
+	return $self->error( "Can't find pod for $class\n" ) unless $path;
+	my $pod = $self->read_file( $path );
 	my $converter = Pod::Simple::HTML->new();
 	my $body;
 	my $my_classes = join('|', $self->classes);
@@ -43,12 +45,89 @@
 	$body =~ s{</body>\s*</html>\s*$}{};
 	$body =~ s!%3A%3A!::!g;
 #	$body =~ s{<a href="http://search\.cpan\.org/perldoc\?($my_classes)"([^>]*)>}{<a href="/$1"$2>}g;
-	$body =~ s{<a href="http://(search\.cpan\.org/perldoc\?)([^"]+)"([^>]*)>([^<]+)<([^>]+)>}{<a href="/$2"$3>$4<$5><sup><a target="$1" title="CPAN" style="text-decoration: none" href="http://$1/$2"$3>&loz;<$5></sup>}g;
+	$body =~ s{<a href="http://(search\.cpan\.org/perldoc\?)([^"]+)"([^>]*)>([^<]+)<([^>]+)>}{<a href="/$2"$3>$4<$5><sup><a target="$1" title="CPAN" style="text-decoration: none" href="http://$1$2"$3>&loz;<$5></sup>}g;
 	$body =~ s!</li>\n\t<ul>!<ul>!;
 	$body =~ s!</ul>!</ul></li>!;
 	$body =~ s!<p></p>!!;
 	$body =~ s!__index__!index!g;
-	return $body;
+
+	our @toc = ();
+
+	sub heading {
+		my ($level,$html) = @_;
+		push @toc, { $level => $html };
+		warn "## heading $level $html" if $self->debug;
+		qq|<$level>$html</$level>|;
+	}
+	$body =~ s{<(h\d+)>(.+?)</\1>}{heading($1,$2)}egs;
+
+	$self->title( $class );
+
+#	$body .= $self->html_dump( $toc );
+	warn "# toc ", dump( @toc );
+
+	my $toc_html = '';
+	my $current_level = 0;
+	foreach my $entry ( @toc ) {
+		my ( $level, $html ) = %$entry;
+
+		if ( $level =~ m{h(\d+)} ) {
+			my $num = $1;
+			if ( $num > $current_level ) {
+				if ( ! $toc_html ) { # first ul
+					$toc_html .= qq|<ul class="first">|;
+				} else {
+					$toc_html .= qq|<ul>|;
+				}
+			} elsif ( $num < $current_level ) {
+				$toc_html .= qq|</ul>|;
+			}
+			$current_level = $num;
+		}
+
+		my $target = $html;
+		$target =~ s{<[^>]+/?>}{}gs; # remove html
+		$target = qq|<a href="#$2">$target</a>| if $html =~ m{<a[^<]+name=(['"]?)([^'"<]+?)\1[^<]+>};
+
+		$toc_html .= qq|<li title="$level">$target</li>\n|;
+	}
+
+	$toc_html .= qq|</ul>| while ( $current_level-- );
+
+	if ( $toc_html && ! wantarray ) {
+		$self->add_css(qq|
+			.pod-toc {
+				float: right;
+				background: #eee;
+				font-size: 80%;
+			}
+			.pod-toc .first {
+				padding-left: 1em;
+				padding-right: 1em;
+			}
+			.pod-toc ul > li {
+				list-style: none;
+			}
+			.pod-toc a {
+				text-decoration: none;
+			}
+
+		|);
+		$toc_html = qq|<div class="pod-toc">$toc_html</div>|;
+	}
+
+	$self->add_css(qq|
+		pre {
+			color: #444;
+			border: 1px solid #eee;
+			padding-top: 0.5em;
+			padding-bottom: 0.5em;
+		}
+	|);
+
+	return ( $toc_html , $body ) if wantarray; 
+	return   $toc_html . $body;
+
 }
 
 1;