#!/usr/local/bin/perl use strict; use warnings; use File::Temp qw(tempdir tempfile); use List::Util qw(reduce sum); my $tabwidth = 4; # Open/fetch our JS file. my $js_file = pop @ARGV; my $doc_name; ($doc_name = $js_file ) =~ s{.+/}{}; $doc_name =~ s/\..+//; # Fetch my JavaScript my $js; if ( -f $js_file ) { # Open my real JavaScript file. open my $js_fh, '<', $js_file or die "Can't open $js_file: $!"; local $/; $js = <$js_fh>; } else { # Use the given filename as a URL instead. require LWP::Simple; $js = LWP::Simple::get( $js_file ); } # Some *awesome* JavaScript parsing. my @pod = map { unindent( $_ ) . "\n\n=cut\n\n" } grep { defined and /\S/ } $js =~ m{/(?:\*(.*?)\*/|/([^\n]))}gxs; unshift @pod, "=cut\n\n"; # Go make a temporary pod file. my $pod_dir = tempdir( CLEANUP => 1 ); my $pod_file = "$pod_dir/$doc_name.pod"; open my $pod_fh, '>', $pod_file or die "Can't create $pod_file: $!"; END { unlink $pod_file } print {$pod_fh} @pod or die "Can't write to $pod_file: $!"; close $pod_fh or die "Can't close $pod_file: $!"; # Run our pod file under perldoc. system 'perldoc', @ARGV, $pod_file; exit; sub unindent { local $_ = shift @_; # Untabify s/\t/' ' x $tabwidth/ge; # Remove trailing whitespace s/\s+\z//; # Unindent by finding the largest quantity of removeable # whitespace. my %leading_space; ++ $leading_space{length $1}{count} while m/^( +)/mg; return $_ unless keys %leading_space; my @indents = sort { $a <=> $b } keys %leading_space; # Compute the space removed for each indentation level. for my $indent_ix ( 0 .. $#indents ) { my $indent = $indents[$indent_ix]; my $lines = 0; $lines += $leading_space{$indents[$_]}{count} for $indent_ix .. $#indents; $leading_space{$indent}{space} = $lines * $indent; } # Select the indentation with the most area removed. my $suggested_padding = reduce { my $current_space = $leading_space{$a}{space}; my $new_space = $leading_space{$b}{space}; $current_space > $new_space ? $a : $b; } ( @indents ); # Remove that much from the start of every line. s/^ {0,$suggested_padding}//mg; return $_; }