t/codingstd/pdd_format.t

   1 #! perl
   2 # Copyright (C) 2001-2005, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use Test::More tests =>  1;
   9 use Carp;
  10 use Cwd;
  11 use Tie::File;
  12
  13 my $cwd = cwd();
  14 my @pdddirs = (
  15     qq{$cwd/docs/pdds},
  16     qq{$cwd/docs/pdds/draft},
  17 );
  18
  19 my @pddfiles = ();
  20 foreach my $dir (@pdddirs) {
  21     my @pdds;
  22     opendir my $DIRH, $dir
  23         or croak "Unable to open directory handle: $!";
  24     @pdds = map { qq|$dir/$_| } grep { m/^pdd\d{2,}_.*\.pod$/ }
  25         readdir $DIRH;
  26     closedir $DIRH or croak "Unable to close directory handle: $!";
  27     @pddfiles = (@pddfiles, @pdds);
  28 }
  29
  30 my @diagnostics = ();
  31 foreach my $pdd (@pddfiles) {
  32     my $diag = check_pdd_formatting($pdd);
  33     if ( $diag ) {
  34         push @diagnostics, $diag;
  35     }
  36 }
  37
  38 my $errmsg = q{};
  39 if ( @diagnostics ) {
  40     $errmsg = join ("\n" => @diagnostics) . "\n";
  41 }
  42
  43 $errmsg ? fail( qq{\n$errmsg} )
  44         : pass( q{All PDDs are formatted correctly} );
  45
  46 sub check_pdd_formatting {
  47     my $pdd = shift;
  48     my $base = $pdd;
  49     if ($pdd =~ m{((draft/)?[^/]+)$}) {
  50         $base = $1;
  51     }
  52     my $diag = q{};
  53     my @toolong = ();
  54     my @sections_needed = qw(
  55         NAME
  56         VERSION
  57         ABSTRACT
  58         DESCRIPTION
  59         IMPLEMENTATION
  60         REFERENCES
  61     );
  62     my %sections_seen = map { $_, 0 } @sections_needed;
  63     my @lines;
  64     tie @lines, 'Tie::File', $pdd
  65         or croak "Unable to tie to $pdd: $!";
  66     for (my $i=0; $i<=$#lines; $i++) {
  67         if (
  68             ( length( $lines[$i] ) > 78 )
  69             and
  70             ( $lines[$i] !~ m/(^(?:L?<)?http|\$Id:\s+)/ )
  71         ) {
  72             push @toolong, ($i + 1);
  73         }
  74         foreach my $need ( @sections_needed ) {
  75             $sections_seen{$need}++ if $lines[$i] =~ m{^=head1\s+$need};
  76         }
  77     }
  78     untie @lines or croak "Unable to untie from $pdd: $!";
  79     if ( @toolong ) {
  80         $diag .=
  81             qq{$base has } .
  82             scalar(@toolong) .
  83             qq{ lines > 78 chars:  @toolong\n};
  84     }
  85     foreach my $need ( keys %sections_seen ) {
  86         if ( ! $sections_seen{$need} ) {
  87             $diag .= qq{$base lacks 'head1' $need section\n};
  88         }
  89     }
  90     return $diag;
  91 }
  92
  93 # Local Variables:
  94 #   mode: cperl
  95 #   cperl-indent-level: 4
  96 #   fill-column: 100
  97 # End:
  98 # vim: expandtab shiftwidth=4: