/[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 455 by dpavlin, Wed Nov 19 15:28:23 2008 UTC revision 1034 by dpavlin, Tue Feb 3 21:24:02 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';
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    =head2 as_markup
25    
26     my $html = $o->as_markup;
27    
28     my ( $toc_html, $html ) = $o->as_markup;
29    
30    =cut
31    
32  sub as_markup {  sub as_markup {
33          my $self = shift;          my $self = shift;
34          my $class = $self->class;          my $class = $self->class;
35          use Pod::Simple::HTML;          use Pod::Simple::HTML;
36          my $path = pod_where( { -inc => 1 }, $class );          my $path = pod_where( { -inc => 1 }, $class );
37          return $self->error( "Can't find pod for $class" ) unless $path;          return $self->error( "Can't find pod for $class\n" ) unless $path;
38          my $pod = read_file( $path );          my $pod = $self->read_file( $path );
39          my $converter = Pod::Simple::HTML->new();          my $converter = Pod::Simple::HTML->new();
40          my $body;          my $body;
41          my $my_classes = join('|', $self->classes);          my $my_classes = join('|', $self->classes);
# Line 41  sub as_markup { Line 50  sub as_markup {
50          $body =~ s!</ul>!</ul></li>!;          $body =~ s!</ul>!</ul></li>!;
51          $body =~ s!<p></p>!!;          $body =~ s!<p></p>!!;
52          $body =~ s!__index__!index!g;          $body =~ s!__index__!index!g;
53          return $body unless wantarray;  
54          return {          our @toc = ();
55                  title => $class,  
56                  body => $body,          sub heading {
57          };                  my ($level,$html) = @_;
58                    push @toc, { $level => $html };
59                    warn "## heading $level $html" if $self->debug;
60                    qq|<$level>$html</$level>|;
61            }
62            $body =~ s{<(h\d+)>(.+?)</\1>}{heading($1,$2)}egs;
63    
64            $self->title( $class );
65    
66    #       $body .= $self->html_dump( $toc );
67            warn "# toc ", dump( @toc );
68    
69            my $toc_html = '';
70            my $current_level = 0;
71            foreach my $entry ( @toc ) {
72                    my ( $level, $html ) = %$entry;
73    
74                    if ( $level =~ m{h(\d+)} ) {
75                            my $num = $1;
76                            if ( $num > $current_level ) {
77                                    if ( ! $toc_html ) { # first ul
78                                            $toc_html .= qq|<ul class="first">|;
79                                    } else {
80                                            $toc_html .= qq|<ul>|;
81                                    }
82                            } elsif ( $num < $current_level ) {
83                                    $toc_html .= qq|</ul>|;
84                            }
85                            $current_level = $num;
86                    }
87    
88                    my $target = $html;
89                    $target =~ s{<[^>]+/?>}{}gs; # remove html
90                    $target = qq|<a href="#$2">$target</a>| if $html =~ m{<a[^<]+name=(['"]?)([^'"<]+?)\1[^<]+>};
91    
92                    $toc_html .= qq|<li title="$level">$target</li>\n|;
93            }
94    
95            $toc_html .= qq|</ul>| while ( $current_level-- );
96    
97            if ( $toc_html && ! wantarray ) {
98                    $self->add_css(qq|
99                            .pod-toc {
100                                    float: right;
101                                    background: #eee;
102                                    font-size: 80%;
103                            }
104                            .pod-toc .first {
105                                    padding-left: 1em;
106                                    padding-right: 1em;
107                            }
108                            .pod-toc ul > li {
109                                    list-style: none;
110                            }
111                            .pod-toc a {
112                                    text-decoration: none;
113                            }
114    
115                    |);
116                    $toc_html = qq|<div class="pod-toc">$toc_html</div>|;
117            }
118    
119            $self->add_css(qq|
120                    pre {
121                            color: #444;
122                            border: 1px solid #eee;
123                            padding-top: 0.5em;
124                            padding-bottom: 0.5em;
125                    }
126            |);
127    
128            return ( $toc_html , $body ) if wantarray;
129            return   $toc_html . $body;
130    
131  }  }
132    
Legend:
Removed from v.455  
changed lines
  Added in v.1034
  ViewVC Help
Powered by ViewVC 1.1.26