t/codingstd/pdd_format.t

   1 #! perl
   2 # Copyright (C) 2001-2009, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use Test::More tests =>  1;
   9 use Carp;
  10 use Tie::File;
  11
  12 my @pdddirs = qw(
  13     ./docs/pdds
  14     ./docs/pdds/draft
  15 );
  16
  17 my @pddfiles = ();
  18 foreach my $dir (@pdddirs) {
  19     die "Directory '$dir' is not found, or not a directory" if not -d $dir;
  20
  21     my @pdds = glob "$dir/pdd*.pod"
  22         or warn "No PDD files found in directory '$dir'";
  23
  24     push @pddfiles, @pdds;
  25 }
  26
  27 my @diagnostics = ();
  28 foreach my $pdd (@pddfiles) {
  29     my $diag = check_pdd_formatting($pdd);
  30     if ( $diag ) {
  31         push @diagnostics, $diag;
  32     }
  33 }
  34
  35 for my $msg (@diagnostics) {
  36     diag($msg);
  37 }
  38 cmp_ok( scalar(@diagnostics), '==', 0, 'PDDs are formatted correctly' );
  39
  40 sub check_pdd_formatting {
  41     my $pdd = shift;
  42
  43     my $diag = q{};
  44     my @toolong = ();
  45     my @sections_needed = qw(
  46         Version
  47         Abstract
  48         Description
  49         Implementation
  50         References
  51     );
  52     my %sections_seen;
  53     my @lines;
  54     tie @lines, 'Tie::File', $pdd
  55         or croak "Unable to tie to $pdd: $!";
  56     for (my $i=0; $i<=$#lines; $i++) {
  57         if (
  58             ( length( $lines[$i] ) > 78 )
  59             and
  60             ( $lines[$i] !~ m/^(?:F|L)<|<http|\$Id:\s+/ )
  61         ) {
  62             push @toolong, ($i + 1);
  63         }
  64         if ( $lines[$i] =~ m{^=head2\s+(.+?)\s*$} ) {
  65             $sections_seen{$1}++;
  66         }
  67     }
  68     untie @lines or croak "Unable to untie from $pdd: $!";
  69     if ( @toolong ) {
  70         $diag .=
  71             qq{$pdd has } .
  72             scalar(@toolong) .
  73             qq{ lines > 78 chars:  @toolong\n};
  74     }
  75     foreach my $need (@sections_needed) {
  76         if ( ! $sections_seen{$need} ) {
  77             $diag .= qq{$pdd lacks 'head2' $need section\n};
  78         }
  79     }
  80     return $diag;
  81 }
  82
  83 # Local Variables:
  84 #   mode: cperl
  85 #   cperl-indent-level: 4
  86 #   fill-column: 100
  87 # End:
  88 # vim: expandtab shiftwidth=4: