File Coverage

blib/lib/Pod/Tree/PerlLib.pm
Criterion Covered Total %
statement 26 129 20.1
branch 0 18 0.0
condition 0 3 0.0
subroutine 9 20 45.0
pod 5 5 100.0
total 40 175 22.8


line stmt bran cond sub pod time code
1             package Pod::Tree::PerlLib;
2 1     1   6172113 use 5.006;
  1         14  
3 1     1   8 use strict;
  1         16  
  1         48  
4 1     1   7 use warnings;
  1         8  
  1         82  
5 1     1   749 use HTML::Stream;
  1         3857  
  1         59  
6 1     1   481 use Pod::Tree;
  1         4  
  1         12  
7 1     1   516 use Pod::Tree::HTML;
  1         3  
  1         8  
8 1     1   585 use Pod::Tree::PerlUtil;
  1         2  
  1         13  
9              
10             our $VERSION = '1.31';
11              
12 1     1   44 use base qw(Pod::Tree::PerlUtil);
  1         3  
  1         124  
13              
14 1     1   6 use constant COLUMN_WIDTH => 30;
  1         3  
  1         1410  
15              
16             sub new {
17 0     0 1   my ( $class, $perl_dir, $html_dir, $link_map, %options ) = @_;
18              
19 0           my %defaults = (
20             col_width => COLUMN_WIDTH,
21             bgcolor => '#ffffff',
22             text => '#000000'
23             );
24 0           my $options = { %defaults, %options, link_map => $link_map };
25              
26 0           my %stop_files = map { $_ => 1 } qw(perllocal.pod);
  0            
27              
28 0           my $perl_lib = {
29             perl_dir => $perl_dir,
30             html_dir => $html_dir,
31             lib_dir => 'lib',
32             top_page => 'lib.html',
33             stop_files => \%stop_files,
34             options => $options
35             };
36              
37 0           bless $perl_lib, $class;
38             }
39              
40             sub scan {
41 0     0 1   my ( $perl_lib, @dirs ) = @_;
42 0           $perl_lib->report1("scan");
43              
44             # Don't try to install PODs for modules on relative paths in @INC
45             # (Typically `.')
46 0           @dirs = grep {m(^/)} @dirs;
  0            
47              
48 0           $perl_lib->_stop_dirs(@dirs);
49              
50 0           for my $dir (@dirs) {
51 0           $perl_lib->{find_dir} = $dir;
52             File::Find::find(
53             {
54 0     0     wanted => sub { $perl_lib->_scan }, # Closures rock!
55 0           no_chdir => 1
56             },
57             $dir
58             );
59             }
60             }
61              
62             sub _stop_dirs {
63 0     0     my ( $perl_lib, @dirs ) = @_;
64              
65 0           for my $dir (@dirs) {
66 0           for my $stop_dir (@dirs) {
67             $stop_dir =~ /^$dir./
68 0 0         and $perl_lib->{stop_dir}{$dir}{$stop_dir} = 1;
69             }
70             }
71             }
72              
73             sub _scan {
74 0     0     my $perl_lib = shift;
75 0           my $source = $File::Find::name;
76              
77 0 0         -d $source and $perl_lib->_scan_dir($source);
78 0 0         -f $source and $perl_lib->_scan_file($source);
79             }
80              
81             sub _scan_dir {
82 0     0     my ( $perl_lib, $dir ) = @_;
83              
84 0           my $find_dir = $perl_lib->{find_dir};
85              
86 0 0 0       if ( $perl_lib->{stop_dir}{$find_dir}{$dir} or $dir =~ /pod$/ ) {
87 0           $File::Find::prune = 1;
88 0           return;
89             }
90              
91 0           my $html_dir = $perl_lib->{html_dir};
92 0           my $lib_dir = $perl_lib->{lib_dir};
93 0           $dir =~ s(^$find_dir)($html_dir/$lib_dir);
94              
95 0           $perl_lib->mkdir($dir);
96             }
97              
98             sub _scan_file {
99 0     0     my ( $perl_lib, $source ) = @_;
100              
101 0 0         $source =~ m(\. (?: pl | pm | pod ) $ )x or return;
102 0           my $file = ( split m(/), $source )[-1];
103 0 0         $perl_lib->{stop_files}{$file} and return;
104 0           my $module = $source;
105 0           my $find_dir = $perl_lib->{find_dir};
106 0           $module =~ s(^$find_dir/)();
107 0           $module =~ s( \.\w+$ )()x; # Foo/Bar
108              
109 0           my $html_dir = $perl_lib->{html_dir};
110 0           my $lib_dir = $perl_lib->{lib_dir};
111 0           my $dest = "$html_dir/$lib_dir/$module.html";
112 0           my ( $name, $description ) = $perl_lib->get_name($source);
113              
114 0 0         $name or return;
115 0           $perl_lib->report2($name);
116              
117 0           my $href = "$module.html";
118 0           my $link = "$lib_dir/$module";
119              
120 0           my $entry = {
121             source => $source, # .../Foo/Bar.pm
122             dest => $dest, # .../html/lib/Foo/Bar.html
123             href => $href, # Foo/Bar.html
124             description => $description
125             };
126              
127 0           $perl_lib->{index}{$name} = $entry;
128 0           $perl_lib->{options}{link_map}->add_page( $name, $link );
129             }
130              
131             sub index {
132 0     0 1   my $perl_lib = shift;
133 0           $perl_lib->report1("index");
134 0           my $html_dir = $perl_lib->{html_dir};
135 0           my $top_page = $perl_lib->{top_page};
136 0           my $dest = "$html_dir/$top_page";
137              
138 0           my $fh = IO::File->new(">$dest");
139 0 0         defined $fh or die "Pod::Tree::PerlLib::index: Can't open $dest: $!\n";
140 0           my $stream = HTML::Stream->new($fh);
141              
142 0           my $options = $perl_lib->{options};
143 0           my $bgcolor = $options->{bgcolor};
144 0           my $text = $options->{text};
145 0           my $title = "Perl Modules";
146              
147 0           $stream->HTML->HEAD;
148 0           $stream->TITLE->text($title)->_TITLE;
149 0           $stream->_HEAD->BODY( BGCOLOR => $bgcolor, TEXT => $text );
150 0           $stream->H1->t($title)->_H1;
151              
152 0           $perl_lib->_emit_entries($stream);
153              
154 0           $stream->_BODY->_HTML;
155             }
156              
157             sub get_top_entry {
158 0     0 1   my $perl_lib = shift;
159              
160             +{
161             URL => $perl_lib->{top_page},
162 0           description => 'Modules'
163             };
164             }
165              
166             sub _emit_entries {
167 0     0     my ( $perl_lib, $stream ) = @_;
168              
169 0           my $lib_dir = $perl_lib->{lib_dir};
170 0           my $index = $perl_lib->{index};
171 0           my $options = $perl_lib->{options};
172 0           my $col_width = $options->{col_width};
173              
174 0           $stream->PRE;
175              
176 0           for my $name ( sort keys %$index ) {
177 0           my $entry = $index->{$name};
178 0           my $href = $entry->{href};
179 0           my $desc = $entry->{description};
180 0           my $pad = $col_width - length $name;
181              
182 0           $stream->A( HREF => "$lib_dir/$href" )->t($name)->_A;
183              
184 0 0         $pad < 1 and do {
185 0           $stream->nl;
186 0           $pad = $col_width;
187             };
188              
189 0           $stream->t( ' ' x $pad, $desc )->nl;
190             }
191              
192 0           $stream->_PRE;
193             }
194              
195             sub translate {
196 0     0 1   my $perl_lib = shift;
197 0           $perl_lib->report1("translate");
198              
199 0           my $index = $perl_lib->{index};
200 0           my $options = $perl_lib->{options};
201              
202 0           for my $name ( sort keys %$index ) {
203 0           $perl_lib->report2($name);
204 0           my @path = split m(::), $name;
205 0           my $depth = @path; # no -1 because they are all under /lib/
206 0           $options->{link_map}->set_depth($depth);
207              
208 0           my $entry = $index->{$name};
209 0           my $source = $entry->{source};
210 0           my $dest = $entry->{dest};
211 0           my $html = Pod::Tree::HTML->new( $source, $dest, %$options );
212 0           $html->translate;
213             }
214             }
215              
216             1
217              
218             __END__