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