#!/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;
-";