Updated

[sdlgit/SDL-Site.git] / tools / PM-Pod2html-snippet.pl

diff --git a/tools/PM-Pod2html-snippet.pl b/tools/PM-Pod2html-snippet.pl
index f93cf9a..34dd814 100644 (file)
--- a/tools/PM-Pod2html-snippet.pl
+++ b/tools/PM-Pod2html-snippet.pl
@@ -7,7 +7,7 @@ use Pod::Xhtml;
 use File::Copy;
 use File::Spec::Functions qw(rel2abs splitpath splitdir catpath catdir catfile canonpath);
 
-my $input_path      = 'C:/SDL_perl/lib/pods';
+my $input_path      = 'D:/dev/SDL_perl/lib/pods';
    $input_path   = $ARGV[0] if $ARGV[0];
 
 my ($volume, $dirs) = splitpath(rel2abs(__FILE__));
@@ -16,9 +16,10 @@ pop(@directories);
 my $parent_dir      = catpath($volume, catdir(@directories));
 my $pages_path      = catdir($parent_dir, 'pages');
 my $assets_path     = catdir($parent_dir, 'htdocs/assets');
-my $parser          = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1);
+my $parser          = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1, LinkParser => new LinkResolver());
 my %module_names    = ();
 my %thumbnails      = ();
+my %files           = ();
 my $fh;
 
 read_file($input_path);
@@ -26,26 +27,59 @@ read_file($input_path);
 # creating index file
 open($fh, '>', File::Spec->catfile($pages_path, 'documentation.html-inc'));
 binmode($fh, ":utf8");
-print($fh "<div class=\"pod\">\n<h1>Documentation (latest development branch)</h1><table>");
-for my $module_name (sort keys %module_names)
+print($fh "<div class=\"pod\">\n<h1>Documentation (latest development branch)</h1>");
+my $last_section = '';
+#for my $module_name (sort keys %module_names)
+for my $key (sort keys %files)
 {
-       my $icon = sprintf('<img src="assets/bubble-%d-mini.png" alt="thumb" />', int((rand() * 7) + 1));
-       my $name = $module_name;
-       my $desc = '';
+       my $icon = defined $files{$key}{'thumb'}
+                ? sprintf('<img src="assets/%s" alt="thumb" />', $files{$key}{'thumb'})
+                : sprintf('<img src="assets/bubble-%d-mini.png" alt="thumb" />', int((rand() * 7) + 1));
+                
+       my @matches = ( $files{$key}{'section'} =~ m/\w+/xg );
        
-       if($module_name =~ /^([^\-]+)\-(.+)$/)
+       if($#matches)
        {
-               $name = $1;
-               $desc = $2;
+               my $section_path = '';
+               my $doit = 1;
+               
+               for my $section (@matches)
+               {
+                       last if $section eq $matches[$#matches];
+                       
+                       $section_path .= (length($section_path) ? ', ' : '') . $section;
+                       
+                       if($last_section =~ /^$section_path/)
+                       {
+                               $doit = 0;
+                       }
+               }
+       
+               if($doit)
+               {
+                       my @this_matches = ( $section_path =~ m/\w+/xg );
+                       my $i = 0;
+                       for my $this_section (@this_matches)
+                       {
+                               printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>', 
+                                                  $i++ * 30, $this_section);
+                       }
+               }
        }
        
-       if(defined $thumbnails{$module_name})
+       if($last_section ne $files{$key}{'section'})
        {
-               $icon = sprintf('<img src="assets/%s" alt="thumb" />', $thumbnails{$module_name});
+               print ($fh '</table>') if $last_section;
+               print ($fh '<br />')  if $last_section && !$#matches;
+               printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>', 
+                          $#matches * 30, pop(@matches));
+               $last_section = $files{$key}{'section'};
        }
        
+       $files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'};
+       
        printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>', 
-                  $icon, $module_names{$module_name}, $name, $desc);
+                  $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
 }
 print($fh "</table></div>\n");
 close($fh);
@@ -60,6 +94,7 @@ sub read_file
                read_file($_) if(-d $_);
                if($_ =~ /\.pod$/i)
                {
+                       my $key         = '';
                        my $file_name   = $_;
                           $file_name   =~ s/^$input_path\/*//;
                        my $module_name = $file_name;
@@ -72,9 +107,20 @@ sub read_file
                           $file_name   = File::Spec->catfile($pages_path, $file_name);
                        $parser->parse_from_file($_); #, $file_name);
                        
-                       $module_name .= " - $1" if $parser->asString =~ /<div id="NAME_CONTENT">\s*<p>\s*[^<>\-]+\-([^<>]+)\s*<\/p>\s*<\/div>/;
                        
-                       $module_names{$module_name} = $file_path;
+                       
+                       $key                    = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
+                                               ? "$1 $_"
+                                               : "UNCATEGORIZED/$_";
+                       $key                    = " $key" if $key =~ /^Core/;
+                       $files{$key}{'path'}    = $file_path;
+                       $files{$key}{'name'}    = $module_name;
+                       $files{$key}{'desc'}    = $parser->asString =~ /<div id="NAME_CONTENT">\s*<p>\s*[^<>\-]+\-([^<>]+)\s*<\/p>\s*<\/div>/
+                                               ? $1
+                                               : '';
+                       $files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
+                                               ? $1
+                                               : 'UNCATEGORIZED';
 
                        # handling images
                        my $image_path  = $_;
@@ -91,7 +137,7 @@ sub read_file
                                        
                                        if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/)
                                        {
-                                               $thumbnails{$module_name} = $image_file_name;
+                                               $files{$key}{'thumb'} = $image_file_name;
                                        }
                                        else
                                        {
@@ -115,3 +161,56 @@ sub read_file
                }
        }
 }
+
+package LinkResolver;
+use Pod::ParseUtils;
+use base qw(Pod::Hyperlink);
+
+sub new
+{
+       my $class = shift;
+       my $css = shift;
+       my $self = $class->SUPER::new();
+       return $self;
+}
+
+sub node
+{
+       my $self = shift;
+       if($self->SUPER::type() eq 'page')
+       {
+               my $page = $self->SUPER::page();
+               my $suff = '';
+               
+               if($page =~ /^SDL\b/)
+               {
+                       $page =~ s/::([A-Z]+)/-$1/g;
+                       $page =~ s/(.*)::(.*)/\/$1.html#$2/;
+                       $page .= '.html' unless $page =~ /\.html/;
+                       
+                       return $page;
+               }
+               else
+               {
+                       return "http://search.cpan.org/perldoc?$page";
+               }
+       }
+       $self->SUPER::node(@_);
+}
+
+sub text
+{
+       my $self = shift;
+       return $self->SUPER::page() if($self->SUPER::type() eq 'page');
+       $self->SUPER::text(@_);
+}
+
+sub type
+{
+       my $self = shift;
+       return "hyperlink" if($self->SUPER::type() eq 'page');
+       $self->SUPER::type(@_);
+}
+
+1;
+