[sdlgit/SDL-Site.git] / tools / PM-Pod2html-snippet.pl

#!/usr/bin/env perl

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      = 'D:/dev/SDL/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 $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($pages_path, 'documentation.html-inc'));
binmode($fh, ":utf8");
print($fh "<div class=\"pod\">\n<h1>Documentation (latest development branch)</h1>");
my $last_section = '';
#for my $module_name (sort keys %module_names)
for my $key (sort keys %files)
{
	my $icon = defined $files{$key}{'thumb'}
	         ? sprintf('<img src="assets/%s" alt="thumb" />', $files{$key}{'thumb'})
	         : sprintf('<img src="assets/bubble-%d-mini.png" alt="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 '<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="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'});
}
print($fh "</table></div>\n");
close($fh);

sub read_file
{
	my $path = shift;
	my @files      = <$path/*>;

	foreach(@files)
	{
		read_file($_) if(-d $_);
		if($_ =~ /\.pod$/i)
		{
            print "Processing $_\n";
			my $key         = '';
			my $file_name   = $_;
			   $file_name   =~ s/^$input_path\/*//;
			my $module_name = $file_name;
			   $module_name =~ s/\//::/g;
			   $module_name =~ s/(\.pm|\.pod)$//i;
			   $file_name   =~ s/\//-/g;
			   $file_name   =~ s/(\.pm|\.pod)$/.html-inc/i;
			my $file_path   = $file_name;
			   $file_path   =~ s/\-inc$//;
			   $file_name   = File::Spec->catfile($pages_path, $file_name);
			$parser->parse_from_file($_); #, $file_name);
			
			
			
			$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>/
			                        ? $1
			                        : '';
			$files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s*<p>\s*([^<>]+)\s*<\/p>\s*<\/div>/
			                        ? $1
			                        : 'UNCATEGORIZED';

			# 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('<a href="assets/%s" target="_blank">'
						                         . '<img src="assets/%s" style="height: 160px" alt="%s"/>'
						                     . '</a>', $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/<!-- INDEX END -->/<!-- INDEX END -->$image_html<hr \/>/ 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;
}

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/&quot;//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;
Commit	Line	Data
b3ef54ec	1	#!/usr/bin/env perl
	2
	3	use strict;
	4	use warnings;
35f7648e	5	use Carp;
d16cf609	6	use Data::Dumper;
b3ef54ec	7	use Pod::Xhtml;
cbc85b7f	8	use File::Copy;
de71a5b8	9	use File::Spec::Functions qw(rel2abs splitpath splitdir catpath catdir catfile canonpath);
4e1ad99d	10
d16cf609	11	my $input_path = 'D:/dev/SDL/lib/pods';
35f7648e	12	$input_path = $ARGV[0] if $ARGV[0];
4e1ad99d	13
de71a5b8	14	my ($volume, $dirs) = splitpath(rel2abs(__FILE__));
	15	my @directories = splitdir(canonpath($dirs));
	16	pop(@directories);
	17	my $parent_dir = catpath($volume, catdir(@directories));
cbc85b7f	18	my $pages_path = catdir($parent_dir, 'pages');
cbc85b7f	19	my $assets_path = catdir($parent_dir, 'htdocs/assets');
46beffd8	20	my $parser = Pod::Xhtml->new(FragmentOnly => 1, StringMode => 1, LinkParser => new LinkResolver());
de71a5b8	21	my %module_names = ();
9f2a2b91	22	my %thumbnails = ();
bfdd9c2e	23	my %files = ();
b3ef54ec	24	my $fh;
	25
	26	read_file($input_path);
	27
	28	# creating index file
cbc85b7f	29	open($fh, '>', File::Spec->catfile($pages_path, 'documentation.html-inc'));
b3ef54ec	30	binmode($fh, ":utf8");
bfdd9c2e	31	print($fh "<div class=\"pod\">\n<h1>Documentation (latest development branch)</h1>");
	32	my $last_section = '';
	33	#for my $module_name (sort keys %module_names)
	34	for my $key (sort keys %files)
b3ef54ec	35	{
bfdd9c2e	36	my $icon = defined $files{$key}{'thumb'}
	37	? sprintf('<img src="assets/%s" alt="thumb" />', $files{$key}{'thumb'})
	38	: sprintf('<img src="assets/bubble-%d-mini.png" alt="thumb" />', int((rand() * 7) + 1));
	39
	40	my @matches = ( $files{$key}{'section'} =~ m/\w+/xg );
9f2a2b91	41
b82df135	42	if($#matches)
	43	{
	44	my $section_path = '';
	45	my $doit = 1;
	46
	47	for my $section (@matches)
	48	{
	49	last if $section eq $matches[$#matches];
	50
	51	$section_path .= (length($section_path) ? ', ' : '') . $section;
	52
	53	if($last_section =~ /^$section_path/)
	54	{
	55	$doit = 0;
	56	}
	57	}
	58
	59	if($doit)
	60	{
	61	my @this_matches = ( $section_path =~ m/\w+/xg );
	62	my $i = 0;
	63	for my $this_section (@this_matches)
	64	{
	65	printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>',
	66	$i++ * 30, $this_section);
	67	}
	68	}
	69	}
	70
bfdd9c2e	71	if($last_section ne $files{$key}{'section'})
9f2a2b91	72	{
bfdd9c2e	73	print ($fh '</table>') if $last_section;
bfdd9c2e	74	print ($fh '<br />') if $last_section && !$#matches;
33a96b1f	75	printf($fh '<table style="margin-left: %dpx; margin-top: 5px"><tr><td colspan="3"><strong style="font-size: 14px">%s</strong></td></tr>',
bfdd9c2e	76	$#matches * 30, pop(@matches));
bfdd9c2e	77	$last_section = $files{$key}{'section'};
9f2a2b91	78	}
9f2a2b91	79
fb9a1059	80	$files{$key}{'desc'} =~ s/^[\-\s]*/- / if $files{$key}{'desc'};
fb9a1059	81
9f2a2b91	82	printf($fh '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td></tr>',
bfdd9c2e	83	$icon, $files{$key}{'path'}, $files{$key}{'name'}, $files{$key}{'desc'});
b3ef54ec	84	}
9f2a2b91	85	print($fh "</table></div>\n");
b3ef54ec	86	close($fh);
	87
	88	sub read_file
	89	{
	90	my $path = shift;
	91	my @files = <$path/*>;
	92
	93	foreach(@files)
	94	{
	95	read_file($_) if(-d $_);
b3ef54ec	96	if($_ =~ /\.pod$/i)
b3ef54ec	97	{
d16cf609	98	print "Processing $_\n";
bfdd9c2e	99	my $key = '';
9f2a2b91	100	my $file_name = $_;
	101	$file_name =~ s/^$input_path\/*//;
	102	my $module_name = $file_name;
	103	$module_name =~ s/\//::/g;
	104	$module_name =~ s/(\.pm\|\.pod)$//i;
	105	$file_name =~ s/\//-/g;
	106	$file_name =~ s/(\.pm\|\.pod)$/.html-inc/i;
	107	my $file_path = $file_name;
	108	$file_path =~ s/\-inc$//;
	109	$file_name = File::Spec->catfile($pages_path, $file_name);
	110	$parser->parse_from_file($_); #, $file_name);
	111
9f2a2b91	112
bfdd9c2e	113
	114	$key = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s<p>\s([^<>]+)\s<\/p>\s<\/div>/
	115	? "$1 $_"
	116	: "UNCATEGORIZED/$_";
60f74f6f	117	$key = " $key" if $key =~ /^Core/;
bfdd9c2e	118	$files{$key}{'path'} = $file_path;
	119	$files{$key}{'name'} = $module_name;
	120	$files{$key}{'desc'} = $parser->asString =~ /<div id="NAME_CONTENT">\s<p>\s[^<>\-]+\-([^<>]+)\s<\/p>\s<\/div>/
	121	? $1
	122	: '';
	123	$files{$key}{'section'} = $parser->asString =~ /<div id="CATEGORY_CONTENT">\s<p>\s([^<>]+)\s<\/p>\s<\/div>/
	124	? $1
	125	: 'UNCATEGORIZED';
9f2a2b91	126
9f2a2b91	127	# handling images
cbc85b7f	128	my $image_path = $_;
	129	$image_path =~ s/\.pod$//;
	130	my @images = <$image_path*>;
	131
	132	my $image_html = '';
	133
	134	foreach my $image_file (@images)
	135	{
9f2a2b91	136	if($image_file =~ /^($image_path)(_\w+){0,1}\.(jpg\|jpeg\|png\|gif)$/)
cbc85b7f	137	{
	138	my (undef, undef, $image_file_name) = splitpath($image_file);
	139
9f2a2b91	140	if($image_file_name =~ /_thumb\.(jpg\|jpeg\|png\|gif)$/)
9f2a2b91	141	{
bfdd9c2e	142	$files{$key}{'thumb'} = $image_file_name;
9f2a2b91	143	}
	144	else
	145	{
	146	$image_html .= sprintf('<a href="assets/%s" target="_blank">'
	147	. '<img src="assets/%s" style="height: 160px" alt="%s"/>'
	148	. '</a>', $image_file_name, $image_file_name, $image_file_name);
	149	}
	150
cbc85b7f	151	copy($image_file, File::Spec->catfile($assets_path, $image_file_name));
	152	}
	153	}
	154
cbc85b7f	155	# modifying the html-snippet and insert the images
	156	my $html = $parser->asString;
	157	$html =~ s/<!-- INDEX END -->/<!-- INDEX END -->$image_html<hr \/>/ if $image_html;
	158
	159	open($fh, '>', $file_name);
	160	binmode($fh, ":utf8");
	161	print($fh $html);
	162	close($fh);
b3ef54ec	163	}
	164	}
	165	}
46beffd8	166
	167	package LinkResolver;
	168	use Pod::ParseUtils;
	169	use base qw(Pod::Hyperlink);
	170
	171	sub new
	172	{
	173	my $class = shift;
	174	my $css = shift;
	175	my $self = $class->SUPER::new();
	176	return $self;
	177	}
	178
d16cf609	179	my $warn = 0;
46beffd8	180	sub node
	181	{
	182	my $self = shift;
d16cf609	183
46beffd8	184	if($self->SUPER::type() eq 'page')
	185	{
	186	my $page = $self->SUPER::page();
92e293d6	187	my $suff = '';
46beffd8	188
d16cf609	189	if($page =~ /^SDL(x)?\b/)
46beffd8	190	{
55bbf7a2	191	$page =~ s/::([A-Z]+)/-$1/g;
d16cf609	192	printf "%03d WARNING: " . $self->SUPER::page() . " better written as L<$2\|$1/\"$2\">\n", ++$warn if $self->SUPER::page() =~ /(.*)::([a-z_]+)$/;
	193
	194	$page =~ s/(.)\/"(.)"/\/$1.html#$2/;
55bbf7a2	195	$page .= '.html' unless $page =~ /\.html/;
92e293d6	196
d16cf609	197	#print $self->SUPER::page() . " -> " . $page . "\n" if $page =~ /Event/;
92e293d6	198	return $page;
46beffd8	199	}
	200	else
	201	{
	202	return "http://search.cpan.org/perldoc?$page";
	203	}
	204	}
d16cf609	205	elsif($self->SUPER::type() eq 'item')
	206	{
	207	my $page = $self->SUPER::page();
	208	my $node = $self->SUPER::node();
	209	my $suff = '';
	210
	211	if($page =~ /^SDL(x)?\b/)
	212	{
	213	$page =~ s/::([A-Z]+)/-$1/g;
	214	$node =~ s/"//g;
	215
	216	return "/$page.html#$node";
	217	}
	218	else
	219	{
	220	return "http://search.cpan.org/perldoc?$page";
	221	}
	222	}
46beffd8	223	$self->SUPER::node(@_);
	224	}
	225
	226	sub text
	227	{
	228	my $self = shift;
	229	return $self->SUPER::page() if($self->SUPER::type() eq 'page');
	230	$self->SUPER::text(@_);
	231	}
	232
	233	sub type
	234	{
	235	my $self = shift;
d16cf609	236	return "hyperlink" if($self->SUPER::type() =~ /(page\|item)/);
46beffd8	237	$self->SUPER::type(@_);
	238	}
	239
	240	1;
	241