use strict;
use warnings;
use Carp;
+use Data::Dumper;
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/lib/pods';
$input_path = $ARGV[0] if $ARGV[0];
my ($volume, $dirs) = splitpath(rel2abs(__FILE__));
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 = ();
read_file($_) if(-d $_);
if($_ =~ /\.pod$/i)
{
+ print "Processing $_\n";
my $key = '';
my $file_name = $_;
$file_name =~ s/^$input_path\/*//;
}
}
}
+
+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;
+}
+
+my $warn = 0;
+sub node
+{
+ my $self = shift;
+
+ if($self->SUPER::type() eq 'page')
+ {
+ my $page = $self->SUPER::page();
+ my $suff = '';
+
+ if($page =~ /^SDL(x)?\b/)
+ {
+ $page =~ s/::([A-Z]+)/-$1/g;
+ printf "%03d WARNING: " . $self->SUPER::page() . " better written as L<$2|$1/\"$2\">\n", ++$warn if $self->SUPER::page() =~ /(.*)::([a-z_]+)$/;
+
+ $page =~ s/(.*)\/"(.*)"/\/$1.html#$2/;
+ $page .= '.html' unless $page =~ /\.html/;
+
+ #print $self->SUPER::page() . " -> " . $page . "\n" if $page =~ /Event/;
+ return $page;
+ }
+ else
+ {
+ return "http://search.cpan.org/perldoc?$page";
+ }
+ }
+ elsif($self->SUPER::type() eq 'item')
+ {
+ my $page = $self->SUPER::page();
+ my $node = $self->SUPER::node();
+ my $suff = '';
+
+ if($page =~ /^SDL(x)?\b/)
+ {
+ $page =~ s/::([A-Z]+)/-$1/g;
+ $node =~ s/"//g;
+
+ return "/$page.html#$node";
+ }
+ 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() =~ /(page|item)/);
+ $self->SUPER::type(@_);
+}
+
+1;
+