Commit | Line | Data |
d80786d0 |
1 | #!/usr/bin/env perl |
2 | |
3 | use strict; |
2f9614a0 |
4 | use warnings; |
d80786d0 |
5 | |
2f9614a0 |
6 | use FindBin qw($Bin); |
7 | use File::Find; |
8 | use File::Spec; |
d80786d0 |
9 | |
2f9614a0 |
10 | sub slurp_file { |
11 | undef $/; |
12 | open(my $fh, '<', shift); |
13 | if(my $whole_file = <$fh>) { |
14 | return $whole_file; |
15 | } else { |
16 | return; |
17 | } |
18 | } |
d80786d0 |
19 | |
2f9614a0 |
20 | sub extract_synopsis { |
21 | my $string = shift || return; |
22 | my $head_or_cut = qr[head|cut]x; |
23 | if($string=~m/^=head1 SYNOPSIS\n(.*?)^=$head_or_cut/sm) { |
24 | return $1; |
25 | } else { |
26 | return; |
27 | } |
28 | } |
d80786d0 |
29 | |
2f9614a0 |
30 | sub normalize_indent { |
31 | my $extracted = shift || return; |
d80786d0 |
32 | |
2f9614a0 |
33 | if($extracted=~m/([ \t]+)(\S+)/) { |
34 | $extracted=~s/^$1//gsm; |
35 | return $extracted; |
36 | } else { |
37 | return; |
38 | } |
39 | } |
d80786d0 |
40 | |
2f9614a0 |
41 | sub create_test_string { |
42 | my $extracted = shift || return; |
43 | return <<TEST |
44 | use strict; |
d80786d0 |
45 | use warnings FATAL => 'all'; |
46 | use Test::More qw(no_plan); |
2f9614a0 |
47 | $extracted |
48 | TEST |
49 | } |
50 | |
51 | sub create_test_path_from_lib { |
52 | my $module_name = shift; |
53 | $module_name =~s/\.pm$//; |
54 | return File::Spec->catfile($Bin, '..', 't', 'synopsis', lc($module_name).'.t'); |
55 | } |
56 | |
57 | sub create_or_update_test { |
58 | my ($string, $target) = @_; |
59 | return unless $string && $target; |
60 | print "Writing $target\n"; |
61 | open my $syn_test, '>', $target |
62 | or die "Couldn't open $target - you screwed something up. Go fix it.\n"; |
63 | print $syn_test $string; |
64 | } |
65 | |
66 | find(sub { |
67 | return unless $_=~/pm$/; |
68 | my $test_string = |
69 | create_test_string |
70 | normalize_indent |
71 | extract_synopsis |
72 | slurp_file $File::Find::name; |
73 | |
74 | create_or_update_test( |
75 | $test_string, |
76 | create_test_path_from_lib($_), |
77 | ); |
78 | }, File::Spec->catfile($Bin, '..', 'lib')); |
79 | |
d80786d0 |
80 | |