/[Frey]/branches/no-pager/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 /branches/no-pager/lib/Frey/Pod.pm

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

revision 737 by dpavlin, Wed Dec 3 21:12:43 2008 UTC revision 738 by dpavlin, Sat Dec 6 15:29:10 2008 UTC
# Line 9  Frey::Pod - display documentation Line 9  Frey::Pod - display documentation
9    
10  extends 'Frey::ClassLoader';  extends 'Frey::ClassLoader';
11  with 'Frey::Web';  with 'Frey::Web';
12    with 'Frey::File';
13    
14  has 'class' => (  has 'class' => (
15          is => 'rw',          is => 'rw',
16          isa => 'Str',          isa => 'Str',
17          required => 1,          required => 1,
18            default => 'Frey::Manual',
19  );  );
20    
 use File::Slurp;  
 use Data::Dump qw/dump/;  
21  use Pod::Find qw/pod_where/;  use Pod::Find qw/pod_where/;
22    use Data::Dump qw/dump/;
23    
24  sub as_markup {  sub as_markup {
25          my $self = shift;          my $self = shift;
# Line 26  sub as_markup { Line 27  sub as_markup {
27          use Pod::Simple::HTML;          use Pod::Simple::HTML;
28          my $path = pod_where( { -inc => 1 }, $class );          my $path = pod_where( { -inc => 1 }, $class );
29          return $self->error( "Can't find pod for $class\n" ) unless $path;          return $self->error( "Can't find pod for $class\n" ) unless $path;
30          my $pod = read_file( $path );          my $pod = $self->read_file( $path );
31          my $converter = Pod::Simple::HTML->new();          my $converter = Pod::Simple::HTML->new();
32          my $body;          my $body;
33          my $my_classes = join('|', $self->classes);          my $my_classes = join('|', $self->classes);
# Line 41  sub as_markup { Line 42  sub as_markup {
42          $body =~ s!</ul>!</ul></li>!;          $body =~ s!</ul>!</ul></li>!;
43          $body =~ s!<p></p>!!;          $body =~ s!<p></p>!!;
44          $body =~ s!__index__!index!g;          $body =~ s!__index__!index!g;
45    
46            our @toc = ();
47    
48            sub heading {
49                    my ($level,$html) = @_;
50                    push @toc, { $level => $html };
51                    warn "# heading $level $html";
52                    qq|<$level>$html</$level>|;
53            }
54            $body =~ s{<(h\d+)>(.+?)</\1>}{heading($1,$2)}egs;
55    
56          $self->title( $class );          $self->title( $class );
57          return $body;  
58    #       $body .= $self->html_dump( $toc );
59            warn "# toc ", dump( @toc );
60    
61            my $toc_html = '';
62            my $current_level = 0;
63            foreach my $entry ( @toc ) {
64                    my ( $level, $html ) = %$entry;
65    
66                    if ( $level =~ m{h(\d+)} ) {
67                            my $num = $1;
68                            if ( $num > $current_level ) {
69                                    if ( ! $toc_html ) { # first ul
70                                            $toc_html .= qq|<ul class="first">|;
71                                    } else {
72                                            $toc_html .= qq|<ul>|;
73                                    }
74                            } elsif ( $num < $current_level ) {
75                                    $toc_html .= qq|</ul>|;
76                            }
77                            $current_level = $num;
78                    }
79    
80                    my $target = $html;
81                    $target =~ s{<[^>]+/?>}{}gs; # remove html
82                    $target = qq|<a href="#$2">$target</a>| if $html =~ m{<a[^<]+name=(['"]?)([^'"<]+?)\1[^<]+>};
83    
84                    $toc_html .= qq|<li title="$level">$target</li>\n|;
85            }
86    
87            if ( $toc_html ) {
88                    $self->add_css(qq|
89                            .pod-toc {
90                                    float: right;
91                                    background: #eee;
92                                    font-size: 80%;
93                            }
94                            .pod-toc .first {
95                                    padding-left: 1em;
96                                    padding-right: 1em;
97                            }
98                            .pod-toc ul > li {
99                                    list-style: none;
100                            }
101                            .pod-toc a {
102                                    text-decoration: none;
103                            }
104                    |);
105                    $toc_html = qq|<div class="pod-toc">$toc_html</div>|;
106            }
107    
108            return $toc_html . $body;
109    
110  }  }
111    
Legend:
Removed from v.737  
changed lines
  Added in v.738
  ViewVC Help
Powered by ViewVC 1.1.26