8 use File::Spec::Functions qw(rel2abs splitpath splitdir catpath catdir catfile canonpath);
10 my $input_path = 'D:/dev/SDL_perl/lib/pods';
11 $input_path = $ARGV[0] if $ARGV[0];
13 my ($volume, $dirs) = splitpath(rel2abs(__FILE__));
14 my @directories = splitdir(canonpath($dirs));
16 my $parent_dir = catpath($volume, catdir(@directories));
17 my $pages_path = catdir($parent_dir, 'pages');
18 my $assets_path = catdir($parent_dir, 'htdocs/assets');
19 my $parser = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1, LinkParser => new LinkResolver());
20 my %module_names = ();
25 read_file($input_path);
28 open($fh, '>', File::Spec->catfile($pages_path, 'documentation.html-inc'));
29 binmode($fh, ":utf8");
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)
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));
39 my @matches = ( $files{$key}{'section'} =~ m/\w+/xg );
43 my $section_path = '';
46 for my $section (@matches)
48 last if $section eq $matches[$#matches];
50 $section_path .= (length($section_path) ? ', ' : '') . $section;
52 if($last_section =~ /^$section_path/)
60 my @this_matches = ( $section_path =~ m/\w+/xg );
62 for my $this_section (@this_matches)
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);
70 if($last_section ne $files{$key}{'section'})
72 print ($fh '</table>') if $last_section;
73 print ($fh '<br />') if $last_section && !$#matches;
74 printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>',
75 $#matches * 30, pop(@matches));
76 $last_section = $files{$key}{'section'};
79 $files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'};
81 printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>',
82 $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
84 print($fh "</table></div>\n");
90 my @files = <$path/*>;
94 read_file($_) if(-d $_);
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);
112 $key = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
114 : "UNCATEGORIZED/$_";
115 $key = " $key" if $key =~ /^Core/;
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>/
121 $files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
127 $image_path =~ s/\.pod$//;
128 my @images = <$image_path*>;
132 foreach my $image_file (@images)
134 if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg|jpeg|png|gif)$/)
136 my (undef, undef, $image_file_name) = splitpath($image_file);
138 if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/)
140 $files{$key}{'thumb'} = $image_file_name;
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);
149 copy($image_file, File::Spec->catfile($assets_path, $image_file_name));
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;
157 open($fh, '>', $file_name);
158 binmode($fh, ":utf8");
165 package LinkResolver;
167 use base qw(Pod::Hyperlink);
173 my $self = $class->SUPER::new();
180 if($self->SUPER::type() eq 'page')
182 my $page = $self->SUPER::page();
185 if($page =~ /^SDL\b/)
187 $page =~ s/::([A-Z]+)/-$1/g;
188 $page =~ s/(.*)::(.*)/\/$1.html#$2/;
189 $page .= '.html' unless $page =~ /\.html/;
195 return "http://search.cpan.org/perldoc?$page";
198 $self->SUPER::node(@_);
204 return $self->SUPER::page() if($self->SUPER::type() eq 'page');
205 $self->SUPER::text(@_);
211 return "hyperlink" if($self->SUPER::type() eq 'page');
212 $self->SUPER::type(@_);