/[Frey]/trunk/lib/Frey/Pod.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/Pod.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 691 by dpavlin, Tue Dec 2 22:06:05 2008 UTC revision 1133 by dpavlin, Tue Jun 30 15:10:55 2009 UTC
# Line 7  Frey::Pod - display documentation Line 7  Frey::Pod - display documentation
7    
8  =cut  =cut
9    
10  extends 'Frey::ClassLoader';  extends 'Frey::Class::Loader';
11  with 'Frey::Web';  with 'Frey::Web', 'Frey::File';
12    
13  has 'class' => (  has 'class' => (
14          is => 'rw',          is => 'rw',
15          isa => 'Str',          isa => 'Str',
16          required => 1,          required => 1,
17            default => 'Frey::Manual',
18  );  );
19    
 use File::Slurp;  
 use Data::Dump qw/dump/;  
20  use Pod::Find qw/pod_where/;  use Pod::Find qw/pod_where/;
21    use Data::Dump qw/dump/;
22    
23    =head2 as_markup
24    
25     my $html = $o->as_markup;
26    
27     my ( $toc_html, $html ) = $o->as_markup;
28    
29    =cut
30    
31  sub as_markup {  sub as_markup {
32          my $self = shift;          my $self = shift;
33          my $class = $self->class;          my $class = $self->class;
34          use Pod::Simple::HTML;          use Pod::Simple::HTML;
35          my $path = pod_where( { -inc => 1 }, $class );          my $path = pod_where( { -inc => 1 }, $class );
36          return $self->error( "Can't find pod for $class" ) unless $path;          return $self->error( "Can't find pod for $class\n" ) unless $path;
37          my $pod = read_file( $path );          my $pod = $self->read_file( $path );
38          my $converter = Pod::Simple::HTML->new();          my $converter = Pod::Simple::HTML->new();
39          my $body;          my $body;
40          my $my_classes = join('|', $self->classes);          my $my_classes = join('|', $self->classes);
# Line 41  sub as_markup { Line 49  sub as_markup {
49          $body =~ s!</ul>!</ul></li>!;          $body =~ s!</ul>!</ul></li>!;
50          $body =~ s!<p></p>!!;          $body =~ s!<p></p>!!;
51          $body =~ s!__index__!index!g;          $body =~ s!__index__!index!g;
52    
53            our @toc = ();
54    
55            sub heading {
56                    my ($level,$html) = @_;
57                    push @toc, { $level => $html };
58                    warn "## heading $level $html" if $self->debug;
59                    qq|<$level>$html</$level>|;
60            }
61            $body =~ s{<(h\d+)>(.+?)</\1>}{heading($1,$2)}egs;
62    
63          $self->title( $class );          $self->title( $class );
64          return $body;  
65    #       $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            $toc_html .= qq|</ul>| while ( $current_level-- );
95    
96            if ( $toc_html && ! wantarray ) {
97                    $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    
114                    |);
115                    $toc_html = qq|<div class="pod-toc">$toc_html</div>|;
116            }
117    
118            $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            return ( $toc_html , $body ) if wantarray;
128            return   $toc_html . $body;
129    
130  }  }
131    
132  1;  __PACKAGE__->meta->make_immutable;
133    no Moose;
134    
135    1;
Legend:
Removed from v.691  
changed lines
  Added in v.1133
  ViewVC Help
Powered by ViewVC 1.1.26