Commit | Line | Data |
b3ef54ec |
1 | #!/usr/bin/env perl |
2 | |
3 | use strict; |
4 | use warnings; |
35f7648e |
5 | use Carp; |
b3ef54ec |
6 | use Pod::Xhtml; |
cbc85b7f |
7 | use File::Copy; |
de71a5b8 |
8 | use File::Spec::Functions qw(rel2abs splitpath splitdir catpath catdir catfile canonpath); |
4e1ad99d |
9 | |
de71a5b8 |
10 | my $input_path = 'C:/SDL_perl/lib/pods'; |
35f7648e |
11 | $input_path = $ARGV[0] if $ARGV[0]; |
4e1ad99d |
12 | |
de71a5b8 |
13 | my ($volume, $dirs) = splitpath(rel2abs(__FILE__)); |
14 | my @directories = splitdir(canonpath($dirs)); |
15 | pop(@directories); |
16 | my $parent_dir = catpath($volume, catdir(@directories)); |
cbc85b7f |
17 | my $pages_path = catdir($parent_dir, 'pages'); |
18 | my $assets_path = catdir($parent_dir, 'htdocs/assets'); |
46beffd8 |
19 | my $parser = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1, LinkParser => new LinkResolver()); |
de71a5b8 |
20 | my %module_names = (); |
9f2a2b91 |
21 | my %thumbnails = (); |
bfdd9c2e |
22 | my %files = (); |
b3ef54ec |
23 | my $fh; |
24 | |
25 | read_file($input_path); |
26 | |
27 | # creating index file |
cbc85b7f |
28 | open($fh, '>', File::Spec->catfile($pages_path, 'documentation.html-inc')); |
b3ef54ec |
29 | binmode($fh, ":utf8"); |
bfdd9c2e |
30 | print($fh "<div class=\"pod\">\n<h1>Documentation (latest development branch)</h1>"); |
31 | my $last_section = ''; |
32 | #for my $module_name (sort keys %module_names) |
33 | for my $key (sort keys %files) |
b3ef54ec |
34 | { |
bfdd9c2e |
35 | my $icon = defined $files{$key}{'thumb'} |
36 | ? sprintf('<img src="assets/%s" alt="thumb" />', $files{$key}{'thumb'}) |
37 | : sprintf('<img src="assets/bubble-%d-mini.png" alt="thumb" />', int((rand() * 7) + 1)); |
38 | |
39 | my @matches = ( $files{$key}{'section'} =~ m/\w+/xg ); |
9f2a2b91 |
40 | |
b82df135 |
41 | if($#matches) |
42 | { |
43 | my $section_path = ''; |
44 | my $doit = 1; |
45 | |
46 | for my $section (@matches) |
47 | { |
48 | last if $section eq $matches[$#matches]; |
49 | |
50 | $section_path .= (length($section_path) ? ', ' : '') . $section; |
51 | |
52 | if($last_section =~ /^$section_path/) |
53 | { |
54 | $doit = 0; |
55 | } |
56 | } |
57 | |
58 | if($doit) |
59 | { |
60 | my @this_matches = ( $section_path =~ m/\w+/xg ); |
61 | my $i = 0; |
62 | for my $this_section (@this_matches) |
63 | { |
64 | printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>', |
65 | $i++ * 30, $this_section); |
66 | } |
67 | } |
68 | } |
69 | |
bfdd9c2e |
70 | if($last_section ne $files{$key}{'section'}) |
9f2a2b91 |
71 | { |
bfdd9c2e |
72 | print ($fh '</table>') if $last_section; |
73 | print ($fh '<br />') if $last_section && !$#matches; |
33a96b1f |
74 | printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>', |
bfdd9c2e |
75 | $#matches * 30, pop(@matches)); |
76 | $last_section = $files{$key}{'section'}; |
9f2a2b91 |
77 | } |
78 | |
fb9a1059 |
79 | $files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'}; |
80 | |
9f2a2b91 |
81 | printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>', |
bfdd9c2e |
82 | $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'}); |
b3ef54ec |
83 | } |
9f2a2b91 |
84 | print($fh "</table></div>\n"); |
b3ef54ec |
85 | close($fh); |
86 | |
87 | sub read_file |
88 | { |
89 | my $path = shift; |
90 | my @files = <$path/*>; |
91 | |
92 | foreach(@files) |
93 | { |
94 | read_file($_) if(-d $_); |
b3ef54ec |
95 | if($_ =~ /\.pod$/i) |
96 | { |
bfdd9c2e |
97 | my $key = ''; |
9f2a2b91 |
98 | my $file_name = $_; |
99 | $file_name =~ s/^$input_path\/*//; |
100 | my $module_name = $file_name; |
101 | $module_name =~ s/\//::/g; |
102 | $module_name =~ s/(\.pm|\.pod)$//i; |
103 | $file_name =~ s/\//-/g; |
104 | $file_name =~ s/(\.pm|\.pod)$/.html-inc/i; |
105 | my $file_path = $file_name; |
106 | $file_path =~ s/\-inc$//; |
107 | $file_name = File::Spec->catfile($pages_path, $file_name); |
108 | $parser->parse_from_file($_); #, $file_name); |
109 | |
9f2a2b91 |
110 | |
bfdd9c2e |
111 | |
112 | $key = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/ |
113 | ? "$1 $_" |
114 | : "UNCATEGORIZED/$_"; |
60f74f6f |
115 | $key = " $key" if $key =~ /^Core/; |
bfdd9c2e |
116 | $files{$key}{'path'} = $file_path; |
117 | $files{$key}{'name'} = $module_name; |
118 | $files{$key}{'desc'} = $parser->asString =~ /<div id="NAME_CONTENT">\s*<p>\s*[^<>\-]+\-([^<>]+)\s*<\/p>\s*<\/div>/ |
119 | ? $1 |
120 | : ''; |
121 | $files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/ |
122 | ? $1 |
123 | : 'UNCATEGORIZED'; |
9f2a2b91 |
124 | |
125 | # handling images |
cbc85b7f |
126 | my $image_path = $_; |
127 | $image_path =~ s/\.pod$//; |
128 | my @images = <$image_path*>; |
129 | |
130 | my $image_html = ''; |
131 | |
132 | foreach my $image_file (@images) |
133 | { |
9f2a2b91 |
134 | if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg|jpeg|png|gif)$/) |
cbc85b7f |
135 | { |
136 | my (undef, undef, $image_file_name) = splitpath($image_file); |
137 | |
9f2a2b91 |
138 | if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/) |
139 | { |
bfdd9c2e |
140 | $files{$key}{'thumb'} = $image_file_name; |
9f2a2b91 |
141 | } |
142 | else |
143 | { |
144 | $image_html .= sprintf('<a href="assets/%s" target="_blank">' |
145 | . '<img src="assets/%s" style="height: 160px" alt="%s"/>' |
146 | . '</a>', $image_file_name, $image_file_name, $image_file_name); |
147 | } |
148 | |
cbc85b7f |
149 | copy($image_file, File::Spec->catfile($assets_path, $image_file_name)); |
150 | } |
151 | } |
152 | |
cbc85b7f |
153 | # modifying the html-snippet and insert the images |
154 | my $html = $parser->asString; |
155 | $html =~ s/<!-- INDEX END -->/<!-- INDEX END -->$image_html<hr \/>/ if $image_html; |
156 | |
157 | open($fh, '>', $file_name); |
158 | binmode($fh, ":utf8"); |
159 | print($fh $html); |
160 | close($fh); |
b3ef54ec |
161 | } |
162 | } |
163 | } |
46beffd8 |
164 | |
165 | package LinkResolver; |
166 | use Pod::ParseUtils; |
167 | use base qw(Pod::Hyperlink); |
168 | |
169 | sub new |
170 | { |
171 | my $class = shift; |
172 | my $css = shift; |
173 | my $self = $class->SUPER::new(); |
174 | return $self; |
175 | } |
176 | |
177 | sub node |
178 | { |
179 | my $self = shift; |
180 | if($self->SUPER::type() eq 'page') |
181 | { |
182 | my $page = $self->SUPER::page(); |
92e293d6 |
183 | my $suff = ''; |
46beffd8 |
184 | |
12f774ac |
185 | if($page =~ /^SDL\b/) |
46beffd8 |
186 | { |
92e293d6 |
187 | $page =~ s/::([A-Z])+/-$1/g; |
188 | $page =~ s/(.*)::(.*)/\/$1.html#$2/; |
189 | |
190 | return $page; |
46beffd8 |
191 | } |
192 | else |
193 | { |
194 | return "http://search.cpan.org/perldoc?$page"; |
195 | } |
196 | } |
197 | $self->SUPER::node(@_); |
198 | } |
199 | |
200 | sub text |
201 | { |
202 | my $self = shift; |
203 | return $self->SUPER::page() if($self->SUPER::type() eq 'page'); |
204 | $self->SUPER::text(@_); |
205 | } |
206 | |
207 | sub type |
208 | { |
209 | my $self = shift; |
210 | return "hyperlink" if($self->SUPER::type() eq 'page'); |
211 | $self->SUPER::type(@_); |
212 | } |
213 | |
214 | 1; |
215 | |