Line # Revision Author
1 126 dpavlin package Frey::Pod;
2 use Moose;
3
4 =head1 NAME
5
6 Frey::Pod - display documentation
7
8 =cut
9
10 797 dpavlin extends 'Frey::Class::Loader';
11 1133 dpavlin with 'Frey::Web', 'Frey::File';
12 126 dpavlin
13 has 'class' => (
14 is => 'rw',
15 isa => 'Str',
16 required => 1,
17 724 dpavlin default => 'Frey::Manual',
18 126 dpavlin );
19
20 724 dpavlin use Pod::Find qw/pod_where/;
21 126 dpavlin use Data::Dump qw/dump/;
22
23 1034 dpavlin =head2 as_markup
24
25 my $html = $o->as_markup;
26
27 my ( $toc_html, $html ) = $o->as_markup;
28
29 =cut
30
31 455 dpavlin sub as_markup {
32 178 dpavlin my $self = shift;
33 my $class = $self->class;
34 126 dpavlin use Pod::Simple::HTML;
35 356 dpavlin my $path = pod_where( { -inc => 1 }, $class );
36 694 dpavlin return $self->error( "Can't find pod for $class\n" ) unless $path;
37 724 dpavlin my $pod = $self->read_file( $path );
38 126 dpavlin my $converter = Pod::Simple::HTML->new();
39 my $body;
40 my $my_classes = join('|', $self->classes);
41 $converter->output_string( \$body );
42 $converter->parse_string_document($pod);
43 $body =~ s{.*?<body [^>]+>}{}s;
44 $body =~ s{</body>\s*</html>\s*$}{};
45 130 dpavlin $body =~ s!%3A%3A!::!g;
46 356 dpavlin # $body =~ s{<a href="http://search\.cpan\.org/perldoc\?($my_classes)"([^>]*)>}{<a href="/$1"$2>}g;
47 376 dpavlin $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;
48 126 dpavlin $body =~ s!</li>\n\t<ul>!<ul>!;
49 $body =~ s!</ul>!</ul></li>!;
50 $body =~ s!<p></p>!!;
51 $body =~ s!__index__!index!g;
52 724 dpavlin
53 our @toc = ();
54
55 sub heading {
56 my ($level,$html) = @_;
57 push @toc, { $level => $html };
58 800 dpavlin warn "## heading $level $html" if $self->debug;
59 724 dpavlin qq|<$level>$html</$level>|;
60 }
61 $body =~ s{<(h\d+)>(.+?)</\1>}{heading($1,$2)}egs;
62
63 691 dpavlin $self->title( $class );
64 379 dpavlin
65 724 dpavlin # $body .= $self->html_dump( $toc );
66 warn "# toc ", dump( @toc );
67
68 my $toc_html = '';
69 my $current_level = 0;
70 foreach my $entry ( @toc ) {
71 my ( $level, $html ) = %$entry;
72
73 if ( $level =~ m{h(\d+)} ) {
74 my $num = $1;
75 if ( $num > $current_level ) {
76 if ( ! $toc_html ) { # first ul
77 $toc_html .= qq|<ul class="first">|;
78 } else {
79 $toc_html .= qq|<ul>|;
80 }
81 } elsif ( $num < $current_level ) {
82 $toc_html .= qq|</ul>|;
83 }
84 $current_level = $num;
85 }
86
87 my $target = $html;
88 $target =~ s{<[^>]+/?>}{}gs; # remove html
89 $target = qq|<a href="#$2">$target</a>| if $html =~ m{<a[^<]+name=(['"]?)([^'"<]+?)\1[^<]+>};
90
91 $toc_html .= qq|<li title="$level">$target</li>\n|;
92 }
93
94 1034 dpavlin $toc_html .= qq|</ul>| while ( $current_level-- );
95
96 if ( $toc_html && ! wantarray ) {
97 724 dpavlin $self->add_css(qq|
98 .pod-toc {
99 float: right;
100 background: #eee;
101 font-size: 80%;
102 }
103 .pod-toc .first {
104 padding-left: 1em;
105 padding-right: 1em;
106 }
107 .pod-toc ul > li {
108 list-style: none;
109 }
110 .pod-toc a {
111 text-decoration: none;
112 }
113 800 dpavlin
114 724 dpavlin |);
115 $toc_html = qq|<div class="pod-toc">$toc_html</div>|;
116 }
117
118 800 dpavlin $self->add_css(qq|
119 pre {
120 color: #444;
121 border: 1px solid #eee;
122 padding-top: 0.5em;
123 padding-bottom: 0.5em;
124 }
125 |);
126
127 1034 dpavlin return ( $toc_html , $body ) if wantarray;
128 return $toc_html . $body;
129 724 dpavlin
130 126 dpavlin }
131
132 1133 dpavlin __PACKAGE__->meta->make_immutable;
133 no Moose;
134
135 126 dpavlin 1;