File Coverage

lib/Test/PAUSE/Permissions.pm

Criterion	Covered	Total	%
statement	18	64	28.1
branch	0	32	0.0
condition	0	26	0.0
subroutine	6	11	54.5
pod	1	1	100.0
total	25	134	18.6

package Test::PAUSE::Permissions;

use strict;
use warnings;
use parent 'Exporter';
use Test::More;
use PAUSE::Permissions;
use Parse::LocalDistribution;

our $VERSION = '0.05';

our @EXPORT = (@Test::More::EXPORT, qw/all_permissions_ok/);

sub all_permissions_ok {
  my $author = shift;

  plan skip_all => 'Set RELEASE_TESTING environmental variable to test this.' unless $ENV{RELEASE_TESTING};

  # Get your id from .pause
  $author ||= _get_pause_user();

  plan skip_all => "Can't determine who is going to release." unless $author;

  # Get authority from META
  my $meta_authority ||= _get_authority_in_meta();

  # Prepare 06perms for testing
  my $perms = PAUSE::Permissions->new;

  # Get packages (respecting no_index)
  my $provides = Parse::LocalDistribution->new->parse();

  # Iterate
SKIP:
  for my $package (keys %$provides) {
    my $authority = uc($meta_authority || $author || '');

    my $mp = $perms->module_permissions($package);

    if (!$mp) {
      pass "$package: no one has permissions ($authority should have the first come)";
      next;
    }
    my @maintainers = $mp->all_maintainers;

    # Author should have permissions, regardless of the authority
    if (grep { uc $_ eq uc $author } @maintainers) {
      pass "$package: $author has a permission";
    }
    else {
      fail "$package: maintained by ".join ', ', @maintainers;
    }

    # $AUTHORITY has no effect in PAUSE.
    # just see if $AUTHORITY matches x_authority for information
    if ($meta_authority) {
      my $file_authority = _get_authority_in_file($package, $provides->{$package});
      if ($file_authority && $file_authority ne $meta_authority) {
        # XXX: should fail?
        diag "$package: \$AUTHORITY ($file_authority) doesn't match x_authority ($meta_authority)";
      }
    }
  }

  done_testing;
}

sub _get_pause_user {
  # Get authority from ~/.pause
  require Config::Identity::PAUSE;
  my %config = Config::Identity::PAUSE->load;
  return $config{user};
}

sub _get_authority_in_meta {
  # Get authority from META
  my $meta = _parse_meta();
  if ($meta && $meta->{x_authority}) {
    my $authority = $meta->{x_authority};
    $authority =~ s/^cpan://i;
    return $authority;
  }
}

sub _parse_meta {
  for my $file (qw/META.json META.yml/) {
    next unless -f $file && -r _;
    my $meta = Parse::CPAN::Meta->load_file($file);
    return $meta if $meta && ref $meta eq ref {};
  }
}

sub _get_authority_in_file {
  my ($package, $package_info) = @_;
  my $file = $package_info->{infile};
  return unless $file && -f $file && -r _;

  open my $fh, '<', $file or return;
  my $in_pod = 0;
  while(<$fh>) {
    last if /__(DATA|END)__/;
    $in_pod = /^=(?!cut?)/ ? 1 : /^=cut/ ? 0 : $in_pod;
    next if $in_pod;

    if (/\$(?:${package}::)?AUTHORITY\s*=.+?(?i:cpan):([A-Za-z0-9]+)/) {
      return $1;
    }
  }
}

1;

__END__