X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=tools%2FPM-Pod2html-snippet.pl;h=c1a67f41c1e36071811ff74f529f164e78a00c42;hb=92e293d6d5adcc910443bf2ef174928e266c625d;hp=ba587c74e68d4ac3f8ed7ac8db91303952d37570;hpb=fb9a1059a3ae94fef524dd61166ec3e7f8f5a6ef;p=sdlgit%2FSDL-Site.git

diff --git a/tools/PM-Pod2html-snippet.pl b/tools/PM-Pod2html-snippet.pl
index ba587c7..c1a67f4 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           = ();
@@ -161,3 +161,55 @@ 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/;
+			
+			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;
+