fixed url-generator

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

diff --git a/tools/PM-Pod2html-snippet.pl b/tools/PM-Pod2html-snippet.pl
index b1393dd..d45d28d 100644 (file)
--- a/tools/PM-Pod2html-snippet.pl
+++ b/tools/PM-Pod2html-snippet.pl
@@ -16,7 +16,7 @@ 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           = ();
@@ -76,6 +76,8 @@ for my $key (sort keys %files)
                $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, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
 }
@@ -159,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;
+