#!/usr/bin/env perl use strict; use warnings; use FindBin qw($Bin); use File::Find; use File::Spec; sub slurp_file { undef $/; open(my $fh, '<', shift); if(my $whole_file = <$fh>) { return $whole_file; } else { return; } } 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; } } sub normalize_indent { my $extracted = shift || return; if($extracted=~m/([ \t]+)(\S+)/) { $extracted=~s/^$1//gsm; return $extracted; } else { return; } } sub create_test_string { my $extracted = shift || return; return < '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$/; create_or_update_test( (create_test_string normalize_indent extract_synopsis slurp_file $File::Find::name), create_test_path_from_lib($_), ); }, File::Spec->catfile($Bin, '..', 'lib'));