X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=tools%2FPM-Pod2html-snippet.pl;h=34dd8145cd0713272f6e8a05c7c6f6b1ca64dd3b;hb=f373167ec31ba16ae0770ba461f9de43f41a7ac1;hp=8f73aa268c64c0daf2088d8ab5f4201b9790f824;hpb=edab2fb500ce7d599dcd828683ad6d9a04ef709e;p=sdlgit%2FSDL-Site.git diff --git a/tools/PM-Pod2html-snippet.pl b/tools/PM-Pod2html-snippet.pl index 8f73aa2..34dd814 100644 --- a/tools/PM-Pod2html-snippet.pl +++ b/tools/PM-Pod2html-snippet.pl @@ -4,34 +4,84 @@ use strict; use warnings; use Carp; 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_perl/lib/pods'; $input_path = $ARGV[0] if $ARGV[0]; my ($volume, $dirs) = splitpath(rel2abs(__FILE__)); my @directories = splitdir(canonpath($dirs)); pop(@directories); my $parent_dir = catpath($volume, catdir(@directories)); -my $output_path = catdir($parent_dir, 'pages'); -my $parser = Pod::Xhtml->new(FragmentOnly => 1); +my $pages_path = catdir($parent_dir, 'pages'); +my $assets_path = catdir($parent_dir, 'htdocs/assets'); +my $parser = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1, LinkParser => new LinkResolver()); my %module_names = (); +my %thumbnails = (); +my %files = (); my $fh; read_file($input_path); # creating index file -open($fh, '>', File::Spec->catfile($output_path, 'documentation.html-inc')); +open($fh, '>', File::Spec->catfile($pages_path, 'documentation.html-inc')); binmode($fh, ":utf8"); print($fh "
\n

Documentation (latest development branch)

"); -for my $module_name (sort keys %module_names) +my $last_section = ''; +#for my $module_name (sort keys %module_names) +for my $key (sort keys %files) { - print($fh '', - $module_name, - '
' - ); + my $icon = defined $files{$key}{'thumb'} + ? sprintf('thumb', $files{$key}{'thumb'}) + : sprintf('thumb', int((rand() * 7) + 1)); + + 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 '', + $i++ * 30, $this_section); + } + } + } + + if($last_section ne $files{$key}{'section'}) + { + print ($fh '
%s
') if $last_section; + print ($fh '
') if $last_section && !$#matches; + printf($fh '', + $#matches * 30, pop(@matches)); + $last_section = $files{$key}{'section'}; + } + + $files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'}; + + printf($fh '', + $icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'}); } -print($fh "\n"); +print($fh "
%s
%s%s%s
\n"); close($fh); sub read_file @@ -44,6 +94,7 @@ sub read_file read_file($_) if(-d $_); if($_ =~ /\.pod$/i) { + my $key = ''; my $file_name = $_; $file_name =~ s/^$input_path\/*//; my $module_name = $file_name; @@ -53,10 +104,113 @@ sub read_file $file_name =~ s/(\.pm|\.pod)$/.html-inc/i; my $file_path = $file_name; $file_path =~ s/\-inc$//; - $module_names{$module_name} = $file_path; - $file_name = File::Spec->catfile($output_path, $file_name); + $file_name = File::Spec->catfile($pages_path, $file_name); + $parser->parse_from_file($_); #, $file_name); + + + + $key = $parser->asString =~ /
\s*

\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 =~ /

\s*

\s*[^<>\-]+\-([^<>]+)\s*<\/p>\s*<\/div>/ + ? $1 + : ''; + $files{$key}{'section'} = $parser->asString =~ /

\s*

\s*([^<>]+)\s*<\/p>\s*<\/div>/ + ? $1 + : 'UNCATEGORIZED'; - $parser->parse_from_file($_, $file_name); + # handling images + my $image_path = $_; + $image_path =~ s/\.pod$//; + my @images = <$image_path*>; + + my $image_html = ''; + + foreach my $image_file (@images) + { + if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg|jpeg|png|gif)$/) + { + my (undef, undef, $image_file_name) = splitpath($image_file); + + if($image_file_name =~ /_thumb\.(jpg|jpeg|png|gif)$/) + { + $files{$key}{'thumb'} = $image_file_name; + } + else + { + $image_html .= sprintf('' + . '%s' + . '', $image_file_name, $image_file_name, $image_file_name); + } + + copy($image_file, File::Spec->catfile($assets_path, $image_file_name)); + } + } + + # modifying the html-snippet and insert the images + my $html = $parser->asString; + $html =~ s//$image_html

/ if $image_html; + + open($fh, '>', $file_name); + binmode($fh, ":utf8"); + print($fh $html); + close($fh); } } } + +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; +