9 use File::Spec::Functions qw(rel2abs splitpath splitdir catpath catdir catfile canonpath);
11 my $input_path = 'D:/dev/SDL/lib/pods';
12 $input_path = $ARGV[0] if $ARGV[0];
14 my ($volume, $dirs) = splitpath(rel2abs(__FILE__));
15 my @directories = splitdir(canonpath($dirs));
17 my $parent_dir = catpath($volume, catdir(@directories));
18 my $pages_path = catdir($parent_dir, 'pages');
19 my $assets_path = catdir($parent_dir, 'htdocs/assets');
20 my $parser = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1, LinkParser => new LinkResolver());
21 my %module_names = ();
26 read_file($input_path);
29 open($fh, '>', File::Spec->catfile($pages_path, 'documentation.html-inc'));
30 binmode($fh, ":utf8");
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)
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));
40 my @matches = ( $files{$key}{'section'} =~ m/\w+/xg );
44 my $section_path = '';
47 for my $section (@matches)
49 last if $section eq $matches[$#matches];
51 $section_path .= (length($section_path) ? ', ' : '') . $section;
53 if($last_section =~ /^$section_path/)
61 my @this_matches = ( $section_path =~ m/\w+/xg );
63 for my $this_section (@this_matches)
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);
71 if($last_section ne $files{$key}{'section'})
73 print ($fh '</table>') if $last_section;
74 print ($fh '<br />') if $last_section && !$#matches;
75 printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>',
76 $#matches * 30, pop(@matches));
77 $last_section = $files{$key}{'section'};
80 $files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'};
82 printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>',
83 $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
85 print($fh "</table></div>\n");
91 my @files = <$path/*>;
95 read_file($_) if(-d $_);
98 print "Processing $_\n";
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);
114 $key = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
116 : "UNCATEGORIZED/$_";
117 $key = " $key" if $key =~ /^Core/;
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>/
123 $files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
129 $image_path =~ s/\.pod$//;
130 my @images = <$image_path*>;
134 foreach my $image_file (@images)
136 if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg|jpeg|png|gif)$/)
138 my (undef, undef, $image_file_name) = splitpath($image_file);
140 if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/)
142 $files{$key}{'thumb'} = $image_file_name;
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);
151 copy($image_file, File::Spec->catfile($assets_path, $image_file_name));
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;
159 open($fh, '>', $file_name);
160 binmode($fh, ":utf8");
167 package LinkResolver;
169 use base qw(Pod::Hyperlink);
175 my $self = $class->SUPER::new();
184 if($self->SUPER::type() eq 'page')
186 my $page = $self->SUPER::page();
189 if($page =~ /^SDL(x)?\b/)
191 $page =~ s/::([A-Z]+)/-$1/g;
192 printf "%03d WARNING: " . $self->SUPER::page() . " better written as L<$2|$1/\"$2\">\n", ++$warn if $self->SUPER::page() =~ /(.*)::([a-z_]+)$/;
194 $page =~ s/(.*)\/"(.*)"/\/$1.html#$2/;
195 $page .= '.html' unless $page =~ /\.html/;
197 #print $self->SUPER::page() . " -> " . $page . "\n" if $page =~ /Event/;
202 return "http://search.cpan.org/perldoc?$page";
205 elsif($self->SUPER::type() eq 'item')
207 my $page = $self->SUPER::page();
208 my $node = $self->SUPER::node();
211 if($page =~ /^SDL(x)?\b/)
213 $page =~ s/::([A-Z]+)/-$1/g;
214 $node =~ s/"//g;
216 return "/$page.html#$node";
220 return "http://search.cpan.org/perldoc?$page";
223 $self->SUPER::node(@_);
229 return $self->SUPER::page() if($self->SUPER::type() eq 'page');
230 $self->SUPER::text(@_);
236 return "hyperlink" if($self->SUPER::type() =~ /(page|item)/);
237 $self->SUPER::type(@_);