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