synopsis extractor on steroids

diff --git a/maint/synopsis-extractor b/maint/synopsis-extractor
index 7c72d5b..ebaf001 100755 (executable)
--- a/maint/synopsis-extractor
+++ b/maint/synopsis-extractor
@@ -1,22 +1,80 @@
 #!/usr/bin/env perl
 
 use strict;
-use warnings FATAL => 'all';
+use warnings;
 
-my $from = do { local (@ARGV, $/) = ('lib/HTML/Zoom.pm'); <> };
+use FindBin qw($Bin);
+use File::Find;
+use File::Spec;
 
-$from =~ s/.*^=head1 SYNOPSIS\n//sm;
+sub slurp_file {
+    undef $/;
+    open(my $fh, '<', shift);
+    if(my $whole_file = <$fh>) {
+        return $whole_file;
+    } else {
+        return;
+    }
+}
 
-$from =~ s/^=head1.*//sm;
+sub extract_synopsis {
+    my $string = shift || return;
+    my $head_or_cut = qr[head|cut]x;
+    if($string=~m/^=head1 SYNOPSIS\n(.*?)^=$head_or_cut/sm) {
+        return $1;
+    } else {
+        return;
+    }
+}
 
-my $code = join "\n", map { s/^  // ? ($_) : () } split "\n", $from;
+sub normalize_indent {
+    my $extracted = shift || return;
 
-open my $syn_test, '>', 't/synopsis.t'
-  or die "Couldn't open t/synopsis.t - you screwed something up. Go fix it.\n";
+    if($extracted=~m/([ \t]+)(\S+)/) {
+        $extracted=~s/^$1//gsm;
+        return $extracted;
+    } else {
+        return;
+    }
+}
 
-print $syn_test "use strict;
+sub create_test_string {
+    my $extracted = shift || return;
+    return <<TEST
+use strict;
 use warnings FATAL => 'all';
 use Test::More qw(no_plan);
+$extracted
+TEST
+}
+
+sub create_test_path_from_lib {
+    my $module_name = shift;
+    $module_name =~s/\.pm$//;
+    return File::Spec->catfile($Bin, '..', 't', 'synopsis', lc($module_name).'.t');
+}
+
+sub create_or_update_test {
+    my ($string, $target) = @_;
+    return unless $string && $target;
+    print "Writing $target\n";
+    open my $syn_test, '>', $target
+      or die "Couldn't open $target - you screwed something up. Go fix it.\n";
+    print $syn_test $string;
+}
+
+find(sub {
+    return unless $_=~/pm$/;
+    my $test_string =
+        create_test_string
+        normalize_indent
+        extract_synopsis
+        slurp_file $File::Find::name;
+
+    create_or_update_test(
+        $test_string,
+        create_test_path_from_lib($_),
+    );
+}, File::Spec->catfile($Bin, '..', 'lib'));
+
 
-$code;
-";