#!/usr/bin/env perl use strict; use warnings; use FindBin (); use File::Find (); use Cwd qw( cwd ); use File::Spec (); use File::Copy qw( copy ); use File::Path qw( make_path ); use Getopt::Long qw( GetOptions ); use bytes (); GetOptions( "outdir=s" => \(my $outdir), ) or die "Usage: $0 [--outdir DIR] DIR\n"; if (!defined $outdir) { $outdir = "$FindBin::RealBin/.."; } else { $outdir = File::Spec->rel2abs($outdir); } my $indir = shift or die "no input project directory name specified.\n"; if (!-d $indir) { die "input directory $indir not found.\n"; } $indir = File::Spec->rel2abs($indir); $indir =~ s{/+$}{}g; (my $full_dist_name = $indir) =~ s{.*/}{}; (my $dist_name = $full_dist_name) =~ s{ [-_] v? ( \d+ (?:\.\d+)* (?: rc\d+ | _\d+ )? ) $ }{}i; $dist_name = lc $dist_name; $dist_name =~ s/\.org$//; my $dist_ver = $1; #print "name: $full_dist_name\n"; #if (defined $dist_ver) { #print "version: $dist_ver\n"; #} my @aliases = gen_aliases($indir, $dist_name); #print "aliases: @aliases\n"; my $poddir = "$outdir/pod/$dist_name"; #warn "poddir: $poddir"; if (!-d $poddir) { make_path($poddir); } my @dist_modules; File::Find::find(\&wanted, $indir); my $index = "dist $dist_name\n"; if ($dist_ver) { $index .= " version $dist_ver\n"; } if (@aliases) { $index .= " aliases @aliases\n"; } if (@dist_modules) { @dist_modules = sort { lc($a->{name}) cmp lc($b->{name}) } @dist_modules; my @names = map { lc($_->{name}) } @dist_modules; $index .= " modules " . join(" ", @names) . "\n"; for my $module (@dist_modules) { $index .= <<_EOC_; module $module->{name} _EOC_ my @aliases = gen_aliases(undef, $module->{name}); if (@aliases) { $index .= " aliases @aliases\n"; } my $sections = $module->{sections}; if (defined $sections) { for my $sec (@$sections) { $index .= " section $sec->{from} $sec->{to} $sec->{title}\n"; } } } } $index .= "\n"; my $index_file = "$outdir/resty.index"; open my $out, ">>:encoding(UTF-8)", $index_file or die "cannot open $index_file for appending: $!\n"; print $out $index; close $out; sub wanted { return unless -f $_ && m/ \. ( md | markdown | pod ) $ /x; my $ext = lc $1; my $docfile = $File::Find::name; my $name = File::Spec->abs2rel($docfile, $indir); return if $name =~ /^node_modules/i; $name = lc $name; $name =~ s{ ^ (?: lib | src | lua | docs? ) / }{}xi; $name =~ s{ \. \w+ $ }{}x; $name =~ s{/}{.}g; $name =~ s/\.org$//; return if length($name) == 1; my $podfile; if ($name =~ / ^ (?: README | index ) $ /xi) { $name = $dist_name; } if ($ext eq 'pod') { $podfile = "$poddir/$name.pod"; copy($docfile, $podfile) or die "cannot copy $docfile to $podfile: $!\n"; } else { my $mdfile = $docfile; #warn $name; #warn "wanted: $File::Find::dir $File::Find::name $_\n"; $podfile = "$poddir/$name.pod"; shell("$FindBin::RealBin/md2pod.pl -o $podfile $mdfile"); } my $dist_module = process_pod($podfile, $name); push @dist_modules, $dist_module; } sub strip_pod_tags { my $pod = shift; if ($pod =~ /[<>]/) { #warn $pod; $pod =~ s/E/</g; $pod =~ s/E/>/g; $pod =~ s/E/./g; $pod =~ s/E/\//g; while ($pod =~ s/\b[CFBI]<([^<>]*)>/$1/g) {} $pod =~ s/\<//g; } $pod; } sub process_pod { my ($infile, $name) = @_; my $dist_module = { name => $name, }; open my $in, "<:encoding(UTF-8)", $infile or die "cannot open $infile for reading: $!\n"; my ($toc_level, $new); while (<$in>) { if (defined $toc_level) { if (/ ^ =head (\d+) /x && $1 >= $toc_level) { undef $toc_level; next; } # ignore the content next; } # !defined $level if (/ ^ =head (\d+) \s+ Table \s+ of \s+ Contents? \s* $ /ix) { $toc_level = $1; # ignore the content next; } $new .= $_; } close $in; open my $out, ">:encoding(UTF-8)", $infile or die "cannot open $infile for writing: $!\n"; print $out $new; close $out; open $in, "<:encoding(UTF-8)", $infile or die "cannot open $infile for reading: $!\n"; my @sections; my $level; while (<$in>) { if (/ ^ =head (\d+) \s+ (\S.*) /mx) { $level = $1; (my $title = $2) =~ s/\s+$//; $title = strip_pod_tags($title); $title = lc $title; $title =~ s/^\s*\d+(\.\d+)*\s+-\s+//; next unless $title =~ /[a-z]+/; my $len = bytes::length($_); my $pos = tell($in) - $len; my $sec = { title => $title, from => $pos, level => $level, }; push @sections, $sec; next; } if (/ ^ =item \s+ (\S.*) /mx) { (my $title = $1) =~ s/\s+$//; next unless defined $level; $title = strip_pod_tags($title); $title = lc $title; $title =~ s/^\s*\*\s*//; $title =~ s/["']//g; next unless $title =~ /[a-z]+/; #warn "section $title"; my $len = bytes::length($_); my $pos = tell($in) - $len; my $sec = { title => $title, from => $pos, level => $level + 1, }; push @sections, $sec; } } my $final_pos = tell $in; close $in; my (%levels, $prev_level); for my $sec (@sections) { my $level = $sec->{level}; if (defined $prev_level && $level <= $prev_level) { for (my $l = $prev_level; $l >= $level; $l--) { my $s = $levels{$l}; next if !defined $s; #warn "setting to..."; $s->{to} = $sec->{from}; delete $levels{$l}; } } if (defined $prev_level && $levels{$level}) { die "Bad level $level"; } $levels{$level} = $sec; $prev_level = $level; } if (defined $prev_level) { for (my $l = $prev_level; $l >= 1; $l--) { my $s = $levels{$l}; next if !defined $s; #warn "setting to..."; $s->{to} = $final_pos; delete $levels{$l}; } } if (%levels) { require Data::Dumper; die "cannot happen: ", Data::Dumper::Dumper(\%levels); } if (@sections) { $dist_module->{sections} = \@sections; } return $dist_module; } sub shell { my $cmd = shift; #warn $cmd; system($cmd) == 0 or die "failed to run command \"$cmd\": $!\n"; } sub gen_aliases { my ($indir, $name) = @_; $name =~ s/-\d+\.\d+.*//g; my @aliases; my $alias = $name; if ($alias =~ s/-nginx-module$//) { $alias =~ s/-/_/g; $alias = "ngx_" . $alias; push @aliases, $alias; } else { $alias = $name; if ($alias =~ s/^ngx_http_(\w+)_module$/ngx_$1/) { push @aliases, $alias; } else { $alias = $name; if ($alias =~ / ^ lua (?: - \w+ )+ $ /x) { $alias =~ s/^lua-//; $alias =~ s/-/./g; push @aliases, $alias; } } } if (defined $indir) { my $config_file = "$indir/config"; if (-f $config_file) { open my $in, $config_file or die "cannot open $config_file for reading: $!\n"; while (<$in>) { if (/ \b ngx_addon_name = .*? (\w+) /x) { my $addon = lc $1; push @aliases, $addon; last; } } close $in; } } return @aliases; }