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 { |
dac431fa |
11 | local (@ARGV, $/) = ($_[0]); <> |
2f9614a0 |
12 | } |
d80786d0 |
13 | |
2f9614a0 |
14 | sub extract_synopsis { |
15 | my $string = shift || return; |
16 | my $head_or_cut = qr[head|cut]x; |
17 | if($string=~m/^=head1 SYNOPSIS\n(.*?)^=$head_or_cut/sm) { |
8d36d8cb |
18 | my $extracted = $1; |
8d36d8cb |
19 | my $begin_end = qr[begin|end]x; |
77198646 |
20 | $extracted=~s/\n^=$begin_end testinfo\n\n//smg; # remove test block |
a42917f6 |
21 | $extracted=~s/^\S.+?$//smg; # wipe out non code lines in pod |
8d36d8cb |
22 | return $extracted; |
2f9614a0 |
23 | } else { |
24 | return; |
25 | } |
26 | } |
d80786d0 |
27 | |
2f9614a0 |
28 | sub normalize_indent { |
29 | my $extracted = shift || return; |
8d36d8cb |
30 | if($extracted=~m/([ \t]+)(\S+)/) { |
2f9614a0 |
31 | $extracted=~s/^$1//gsm; |
32 | return $extracted; |
33 | } else { |
34 | return; |
35 | } |
36 | } |
d80786d0 |
37 | |
2f9614a0 |
38 | sub create_test_string { |
39 | my $extracted = shift || return; |
40 | return <<TEST |
41 | use strict; |
d80786d0 |
42 | use warnings FATAL => 'all'; |
43 | use Test::More qw(no_plan); |
2f9614a0 |
44 | $extracted |
45 | TEST |
46 | } |
47 | |
48 | sub create_test_path_from_lib { |
49 | my $module_name = shift; |
50 | $module_name =~s/\.pm$//; |
51 | return File::Spec->catfile($Bin, '..', 't', 'synopsis', lc($module_name).'.t'); |
52 | } |
53 | |
8d36d8cb |
54 | sub create_or_update_test_file { |
55 | my ($target, $synopsis_string) = @_; |
56 | return unless $synopsis_string && $target; |
2f9614a0 |
57 | print "Writing $target\n"; |
58 | open my $syn_test, '>', $target |
59 | or die "Couldn't open $target - you screwed something up. Go fix it.\n"; |
8d36d8cb |
60 | print $syn_test $synopsis_string; |
2f9614a0 |
61 | } |
62 | |
4c8ee496 |
63 | sub wanted { |
8d36d8cb |
64 | my $target_path = |
65 | create_test_path_from_lib $_; |
66 | my $synopsis_string = |
67 | create_test_string |
2f9614a0 |
68 | normalize_indent |
69 | extract_synopsis |
8d36d8cb |
70 | slurp_file $File::Find::name; |
8d36d8cb |
71 | create_or_update_test_file |
72 | $target_path, |
73 | $synopsis_string, |
4c8ee496 |
74 | } |
8d36d8cb |
75 | |
4c8ee496 |
76 | find(\&wanted, File::Spec->catfile($Bin, '..', 'lib')); |
d80786d0 |
77 | |