tools/PM-Pod2html-snippet.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use Pod::Xhtml;
   7 use File::Copy;
   8 use File::Spec::Functions qw(rel2abs splitpath splitdir catpath catdir catfile canonpath);
   9
  10 my $input_path      = 'C:/SDL_perl/lib/pods';
  11    $input_path   = $ARGV[0] if $ARGV[0];
  12
  13 my ($volume, $dirs) = splitpath(rel2abs(__FILE__));
  14 my @directories     = splitdir(canonpath($dirs));
  15 pop(@directories);
  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);
  20 my %module_names    = ();
  21 my %thumbnails      = ();
  22 my %files           = ();
  23 my $fh;
  24
  25 read_file($input_path);
  26
  27 # creating index file
  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)
  34 {
  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 );
  40
  41         if($last_section ne $files{$key}{'section'})
  42         {
  43                 print ($fh '</table>') if $last_section;
  44                 print ($fh '<br />')  if $last_section && !$#matches;
  45                 printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>',
  46                            $#matches * 30, pop(@matches));
  47                 $last_section = $files{$key}{'section'};
  48         }
  49
  50         printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>',
  51                    $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
  52 }
  53 print($fh "</table></div>\n");
  54 close($fh);
  55
  56 sub read_file
  57 {
  58         my $path = shift;
  59         my @files      = <$path/*>;
  60
  61         foreach(@files)
  62         {
  63                 read_file($_) if(-d $_);
  64                 if($_ =~ /\.pod$/i)
  65                 {
  66                         my $key         = '';
  67                         my $file_name   = $_;
  68                            $file_name   =~ s/^$input_path\/*//;
  69                         my $module_name = $file_name;
  70                            $module_name =~ s/\//::/g;
  71                            $module_name =~ s/(\.pm|\.pod)$//i;
  72                            $file_name   =~ s/\//-/g;
  73                            $file_name   =~ s/(\.pm|\.pod)$/.html-inc/i;
  74                         my $file_path   = $file_name;
  75                            $file_path   =~ s/\-inc$//;
  76                            $file_name   = File::Spec->catfile($pages_path, $file_name);
  77                         $parser->parse_from_file($_); #, $file_name);
  78
  79
  80
  81                         $key                    = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
  82                                                 ? "$1 $_"
  83                                                 : "UNCATEGORIZED/$_";
  84                         $key                    = " $key" if $key =~ /^Core/;
  85                         $files{$key}{'path'}    = $file_path;
  86                         $files{$key}{'name'}    = $module_name;
  87                         $files{$key}{'desc'}    = $parser->asString =~ /<div id="NAME_CONTENT">\s*<p>\s*[^<>\-]+\-([^<>]+)\s*<\/p>\s*<\/div>/
  88                                                 ? $1
  89                                                 : '';
  90                         $files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
  91                                                 ? $1
  92                                                 : 'UNCATEGORIZED';
  93
  94                         # handling images
  95                         my $image_path  = $_;
  96                            $image_path  =~ s/\.pod$//;
  97                         my @images = <$image_path*>;
  98
  99                         my $image_html = '';
 100
 101                         foreach my $image_file (@images)
 102                         {
 103                                 if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg|jpeg|png|gif)$/)
 104                                 {
 105                                         my (undef, undef, $image_file_name) = splitpath($image_file);
 106
 107                                         if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/)
 108                                         {
 109                                                 $files{$key}{'thumb'} = $image_file_name;
 110                                         }
 111                                         else
 112                                         {
 113                                                 $image_html .= sprintf('<a href="assets/%s" target="_blank">'
 114                                                                          . '<img src="assets/%s" style="height: 160px" alt="%s"/>'
 115                                                                      . '</a>', $image_file_name, $image_file_name, $image_file_name);
 116                                         }
 117
 118                                         copy($image_file, File::Spec->catfile($assets_path, $image_file_name));
 119                                 }
 120                         }
 121
 122                         # modifying the html-snippet and insert the images
 123                         my $html = $parser->asString;
 124                            $html =~ s/<!-- INDEX END -->/<!-- INDEX END -->$image_html<hr \/>/ if $image_html;
 125
 126                         open($fh, '>', $file_name);
 127                         binmode($fh, ":utf8");
 128                         print($fh $html);
 129                         close($fh);
 130                 }
 131         }
 132 }