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=d1d11229a9da6f25258cfa1b88cabe8feedc9f21;hpb=bfdd9c2e4183a999f6f15f019df08ce94f868c52;p=sdlgit%2FSDL-Site.git

diff --git a/tools/PM-Pod2html-snippet.pl b/tools/PM-Pod2html-snippet.pl
index d1d1122..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 '<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($last_section ne $files{$key}{'section'})
 	{
 		print ($fh '</table>') if $last_section;
 		print ($fh '<br />')  if $last_section && !$#matches;
-		printf($fh '<table style="padding-left: %dpx"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>', 
+		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, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
 }
@@ -81,6 +112,7 @@ sub read_file
 			$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>/
@@ -129,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;
+