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($#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
  70         if($last_section ne $files{$key}{'section'})
  71         {
  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'};
  77         }
  78
  79         printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>',
  80                    $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
  81 }
  82 print($fh "</table></div>\n");
  83 close($fh);
  84
  85 sub read_file
  86 {
  87         my $path = shift;
  88         my @files      = <$path/*>;
  89
  90         foreach(@files)
  91         {
  92                 read_file($_) if(-d $_);
  93                 if($_ =~ /\.pod$/i)
  94                 {
  95                         my $key         = '';
  96                         my $file_name   = $_;
  97                            $file_name   =~ s/^$input_path\/*//;
  98                         my $module_name = $file_name;
  99                            $module_name =~ s/\//::/g;
 100                            $module_name =~ s/(\.pm|\.pod)$//i;
 101                            $file_name   =~ s/\//-/g;
 102                            $file_name   =~ s/(\.pm|\.pod)$/.html-inc/i;
 103                         my $file_path   = $file_name;
 104                            $file_path   =~ s/\-inc$//;
 105                            $file_name   = File::Spec->catfile($pages_path, $file_name);
 106                         $parser->parse_from_file($_); #, $file_name);
 107
 108
 109
 110                         $key                    = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
 111                                                 ? "$1 $_"
 112                                                 : "UNCATEGORIZED/$_";
 113                         $key                    = " $key" if $key =~ /^Core/;
 114                         $files{$key}{'path'}    = $file_path;
 115                         $files{$key}{'name'}    = $module_name;
 116                         $files{$key}{'desc'}    = $parser->asString =~ /<div id="NAME_CONTENT">\s*<p>\s*[^<>\-]+\-([^<>]+)\s*<\/p>\s*<\/div>/
 117                                                 ? $1
 118                                                 : '';
 119                         $files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
 120                                                 ? $1
 121                                                 : 'UNCATEGORIZED';
 122
 123                         # handling images
 124                         my $image_path  = $_;
 125                            $image_path  =~ s/\.pod$//;
 126                         my @images = <$image_path*>;
 127
 128                         my $image_html = '';
 129
 130                         foreach my $image_file (@images)
 131                         {
 132                                 if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg|jpeg|png|gif)$/)
 133                                 {
 134                                         my (undef, undef, $image_file_name) = splitpath($image_file);
 135
 136                                         if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/)
 137                                         {
 138                                                 $files{$key}{'thumb'} = $image_file_name;
 139                                         }
 140                                         else
 141                                         {
 142                                                 $image_html .= sprintf('<a href="assets/%s" target="_blank">'
 143                                                                          . '<img src="assets/%s" style="height: 160px" alt="%s"/>'
 144                                                                      . '</a>', $image_file_name, $image_file_name, $image_file_name);
 145                                         }
 146
 147                                         copy($image_file, File::Spec->catfile($assets_path, $image_file_name));
 148                                 }
 149                         }
 150
 151                         # modifying the html-snippet and insert the images
 152                         my $html = $parser->asString;
 153                            $html =~ s/<!-- INDEX END -->/<!-- INDEX END -->$image_html<hr \/>/ if $image_html;
 154
 155                         open($fh, '>', $file_name);
 156                         binmode($fh, ":utf8");
 157                         print($fh $html);
 158                         close($fh);
 159                 }
 160         }
 161 }