view release on metacpan or  search on metacpan

lib/App/perl/distrolint/Check/Pod.pm  view on Meta::CPAN

}

=head2 Checks on C<NAME>

After a C<=head1 NAME> there should be exactly one paragraph, and its content
should match C<NAME - text>, where C<NAME> should match the module name
implied by the file's path, optionally wrapped in C<CE<lt>...E<gt>> formatting.

=cut

method check_nodes_NAME ( $file, @nodes )
{
   if( @nodes > 1 ) {
      App->diag( App->format_file( $file ), " has more than one paragraph under =head1 NAME" );
      return 0;
   }

   my $content = $nodes[0]->text =~ s/\n/ /gr;
   my $line = $nodes[0]->start_row + 1;

   unless( $content =~ m/^(.*) - (.*)$/ ) {
      App->diag( App->format_file( $file, $line ), " =head1 NAME section does not look like Package::Name - description" );
      return 0;
   }
   my ( $pkgname, $description ) = ( $1, $2 );
   unless( $pkgname =~ s/^C<(.*)>$/$1/ ) {
      if( App::perl::distrolint::Config->check_config( $self, "require_name_code_wrapped", 1 ) ) {
         App->diag( App->format_file( $file, $line ), " =head1 NAME is not wrapped in C<...> tag" );
         return 0;
      }
   }

   $file =~ m{^lib/(.*).pm$} or return 1;
   my $pkgname_from_file = $1 =~ s{/}{::}gr;

   unless( $pkgname eq $pkgname_from_file ) {
      App->diag( App->format_file( $file, $line ), " =head1 NAME section should start C<$pkgname_from_file> - ..." );
      return 0;
   }

   return 1;
}

=head2 Checks on C<FUNCTIONS> and C<METHODS>

For every C<=head2> inside C<=head1 FUNCTIONS> or C<=head1 METHODS>, the text
is checked to ensure it is a bareword function/method name, optionally
followed by other clarifying text after whitespace.

After every C<=head2> the next paragraph must be a verbatim paragraph,
presumed to contain the function's minsynopsis code. The contents of this
are also checked, to see that the first line looks like an example calling
the named function or method, that ends in a semicolon.

The function name can optionally be preceeded by a variable assignment to
indicate the return value (C<$var = ...> or C<($list, $of, @vars) = ...>),
optionally prefixed with C<my>. It can optionally be preceeded by a variable
containing the invocant name and a method call arrow (C<< $var->... >>). It
can optionally be followed by any other text in parentheses, to indicate the
arguments passed. It can optionally use an C<await> expression, used to
indicate it is a L<Future>-returning asynchronous function or method.

E.g.

=for highlighter language=perl

   funcname;
   funcname(@args);
   $self->methodname(@args);
   $result = funcname(args, here);
   my ($return, $values) = Some::Package->methodname(some, more, args);
   my $response = await $client->call;

=cut

method check_head2_FUNCTIONS ( $file, $node ) { $self->_check_head2_func( $file, FUNCTIONS => $node ) }
method check_head2_METHODS   ( $file, $node ) { $self->_check_head2_func( $file, METHODS   => $node ) }

method _check_head2_func ( $file, $head1_title, $node )
{
   my $text = $node->text;
   if( $text !~ m/^(\w+)(?:\s+.*)?$/ ) {
      App->diag(
         App->format_file( $file, $node->start_row + 1 ),
         " $head1_title should be =head2 barename; is ",
         App->format_literal( $text ) );
      return 0;
   }

   return 1;
}

method check_nodes_FUNCTIONS ( $file, @nodes ) { $self->_check_nodes_func( $file, FUNCTIONS => @nodes ); }
method check_nodes_METHODS   ( $file, @nodes ) { $self->_check_nodes_func( $file, METHODS => @nodes ); }

method _check_nodes_func ( $file, $head1_title, @nodes )
{
   my $ok = 1;

   my $last_head2;

   while( @nodes ) {
      my $node = shift @nodes;
      my $type = $node->type;

      my $contentnode = first { $_->type eq "content" } $node->child_nodes;

      if( $type eq "command_paragraph" and $node->child_by_field_name( "command" )->text eq "=head2" ) {
         $last_head2 = $contentnode;
         my $funcname = ( split m/\s+/, $last_head2->text )[0];

         # Having just switched to a new head2 we immediately expect a verbatim paragraph

         # Though it's possible we might have more head2s first to give multiple headings
         while( @nodes and $nodes[0]->type eq "command_paragraph" and
                $nodes[0]->child_by_field_name( "command" )->text eq "=head2" ) {
            shift @nodes;
         }

         $node = shift @nodes;
         unless( $node and $node->type eq "verbatim_paragraph" ) {