X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=tools%2FPM-Pod2html-snippet.pl;h=d45d28db8e4d35057991f766417d965e445c0061;hb=55bbf7a209993f4172fd7e6555dda0947b844089;hp=d47eb1886ca692c095d16f3037039ecc017982ac;hpb=60f74f6f8f641636a03bd789ede09bebe208108b;p=sdlgit%2FSDL-Site.git
diff --git a/tools/PM-Pod2html-snippet.pl b/tools/PM-Pod2html-snippet.pl
index d47eb18..d45d28d 100644
--- 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 = ();
@@ -38,15 +38,46 @@ for my $key (sort keys %files)
my @matches = ( $files{$key}{'section'} =~ m/\w+/xg );
+ if($#matches)
+ {
+ 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 '
%s |
',
+ $i++ * 30, $this_section);
+ }
+ }
+ }
+
if($last_section ne $files{$key}{'section'})
{
print ($fh '
') if $last_section;
print ($fh '
') if $last_section && !$#matches;
- printf($fh '%s |
',
+ printf($fh '%s |
',
$#matches * 30, pop(@matches));
$last_section = $files{$key}{'section'};
}
+ $files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'};
+
printf($fh '%s | %s | %s |
',
$icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
}
@@ -130,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;
+