maint/synopsis-extractor

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