File Coverage

blib/lib/Gentoo/Util/VirtualDepend.pm

Criterion	Covered	Total	%
statement	79	96	82.2
branch	27	50	54.0
condition	4	6	66.6
subroutine	15	21	71.4
pod	11	11	100.0
total	136	184	73.9

use 5.006;
use strict;
use warnings;

package Gentoo::Util::VirtualDepend;

our $VERSION = '0.003023';

# ABSTRACT: Hard-coded replacements for perl-core/ dependencies and dependencies with odd names in Gentoo

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use Moo qw( has );
use Path::Tiny qw( path );
use File::ShareDir qw( dist_file );

# Note: this should be the version default max_perl is in
use Module::CoreList 5.20151213;










# Note: This should be the latest visible version in portage at time of release
has max_perl => ( is => 'ro', lazy => 1, default => sub { '5.22.1' } );










# Note: This should be the lowest visible version 12 months prior to the time of release
has min_perl => ( is => 'ro', lazy => 1, default => sub { '5.18.2' } );

my %MOD2GENTOO;
my $MOD2GENTOO_LOADED;
my $MOD2GENTOO_FILE = 'module-to-gentoo.csv';

my %DIST2GENTOO;
my $DIST2GENTOO_LOADED;
my $DIST2GENTOO_FILE = 'dist-to-gentoo.csv';

my %GENTOO2DIST;
my %GENTOO2MOD;

my $DIST = q[Gentoo-Util-VirtualDepend];

sub _load_mod2gentoo {
  return if $MOD2GENTOO_LOADED;
  my $fh = path( dist_file( $DIST, $MOD2GENTOO_FILE ) )->openr_raw;
  while ( my $line = <$fh> ) {
    chomp $line;
    my ( $module, $map ) = split /,/, $line;    ## no critic (RegularExpressions)
    $MOD2GENTOO{$module} = $map;
    $GENTOO2MOD{$map} = [] unless exists $GENTOO2MOD{$map};
    push @{ $GENTOO2MOD{$map} }, $module;
  }
  return $MOD2GENTOO_LOADED = 1;
}

sub _load_dist2gentoo {
  return if $DIST2GENTOO_LOADED;
  my $fh = path( dist_file( $DIST, $DIST2GENTOO_FILE ) )->openr_raw;
  while ( my $line = <$fh> ) {
    chomp $line;
    my ( $module, $map ) = split /,/, $line;    ## no critic (RegularExpressions)
    $DIST2GENTOO{$module} = $map;
    $GENTOO2DIST{$map} = [] unless exists $GENTOO2DIST{$map};
    push @{ $GENTOO2DIST{$map} }, $module;
  }
  return $DIST2GENTOO_LOADED = 1;
}

sub has_module_override {
  my ( undef, $module ) = @_;
  _load_mod2gentoo unless $MOD2GENTOO_LOADED;
  return exists $MOD2GENTOO{$module};
}

sub get_module_override {
  my ( undef, $module ) = @_;
  _load_mod2gentoo unless $MOD2GENTOO_LOADED;
  return $MOD2GENTOO{$module};
}

sub has_dist_override {
  my ( undef, $dist ) = @_;
  _load_dist2gentoo unless $DIST2GENTOO_LOADED;
  return exists $DIST2GENTOO{$dist};
}

sub get_dist_override {
  my ( undef, $dist ) = @_;
  _load_mod2gentoo unless $DIST2GENTOO_LOADED;
  return $DIST2GENTOO{$dist};
}

sub has_gentoo_package {
  my ( undef, $package ) = @_;
  _load_dist2gentoo unless $DIST2GENTOO_LOADED;
  return exists $GENTOO2DIST{$package};
}

sub get_dists_in_gentoo_package {
  my ( undef, $package ) = @_;
  _load_dist2gentoo unless $DIST2GENTOO_LOADED;
  return @{ $GENTOO2DIST{$package} || [] };
}

sub get_modules_in_gentoo_package {
  my ( undef, $package ) = @_;
  _load_mod2gentoo unless $MOD2GENTOO_LOADED;
  return @{ $GENTOO2MOD{$package} || [] };
}

sub get_known_gentoo_packages {
  _load_dist2gentoo unless $DIST2GENTOO_LOADED;
  return keys %GENTOO2DIST;
}

sub get_known_dists {
  _load_dist2gentoo unless $DIST2GENTOO_LOADED;
  return keys %DIST2GENTOO;
}

sub get_known_modules {
  _load_mod2gentoo unless $MOD2GENTOO_LOADED;
  return keys %MOD2GENTOO;
}

sub module_is_perl {
  my ( $self, $opts, $module, $mod_version ) = @_;
  if ( not ref $opts ) {
    ( $opts, $module, $mod_version ) = ( {}, $opts, $module );
  }

  # If the module has a virtual, don't even consider
  # CPAN/perl decisions

  return if $self->has_module_override($module);
  require version;

  $opts->{min_perl} ||= $self->min_perl;
  my $min_perl = version->parse( $opts->{min_perl} );
  $opts->{max_perl} ||= $self->max_perl;
  my $max_perl = version->parse( $opts->{max_perl} );

  my $seen;
  ## no critic (Variables::ProhibitPackageVars)
  for my $version ( keys %Module::CoreList::version ) {
    my $perlver = version->parse($version);
    ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
    next unless $perlver >= $min_perl;
    next unless $perlver <= $max_perl;

    # If any version in the range returns "deprecated", then we should
    # default to CPAN
    return if $Module::CoreList::deprecated{$version}{$module};

    # If any version in the range does not exist, then we should default to CPAN
    #
    return if not exists $Module::CoreList::version{$version}{$module};

    if ( not defined $mod_version ) {
      $seen = 1;
      next;
    }

    # If any version in the range is undef, and a specific version is requested,
    # Default to CPAN, because it means a virtual is not provisioned.
    return if not defined $Module::CoreList::version{$version}{$module};

    my $this_version = version->parse( $Module::CoreList::version{$version}{$module} );

    # If any version in the range is lower than required, default to CPAN
    # because it means a virtual is not provisioned, and a breakage will occur
    # on one of the versions.
    return if $this_version < version->parse($mod_version);

    $seen = 1;
  }
  return $seen;
}

no Moo;

1;

__END__