File Coverage

blib/lib/Dist/CheckConflicts.pm

Criterion	Covered	Total	%
statement	119	120	99.1
branch	34	38	89.4
condition	16	20	80.0
subroutine	17	17	100.0
pod	4	4	100.0
total	190	199	95.4

package Dist::CheckConflicts;
BEGIN {
  $Dist::CheckConflicts::AUTHORITY = 'cpan:DOY';
}
$Dist::CheckConflicts::VERSION = '0.11';
use strict;
use warnings;
use 5.006;
# ABSTRACT: declare version conflicts for your dist

use base 'Exporter';
our @EXPORT = our @EXPORT_OK = (
    qw(conflicts check_conflicts calculate_conflicts dist)
);

use Carp;
use Module::Runtime 0.009 'module_notional_filename', 'require_module';


my %CONFLICTS;
my %HAS_CONFLICTS;
my %DISTS;

sub import {
    my $pkg = shift;
    my $for = caller;

    my ($conflicts, $alsos, $dist);
    ($conflicts, @_) = _strip_opt('-conflicts' => @_);
    ($alsos, @_)     = _strip_opt('-also' => @_);
    ($dist, @_)      = _strip_opt('-dist' => @_);

    my %conflicts = %{ $conflicts || {} };
    for my $also (@{ $alsos || [] }) {
        eval { require_module($also) } or next;
        if (!exists $CONFLICTS{$also}) {
            $also .= '::Conflicts';
            eval { require_module($also) } or next;
        }
        if (!exists $CONFLICTS{$also}) {
            next;
        }
        my %also_confs = $also->conflicts;
        for my $also_conf (keys %also_confs) {
            $conflicts{$also_conf} = $also_confs{$also_conf}
                if !exists $conflicts{$also_conf}
                || $conflicts{$also_conf} lt $also_confs{$also_conf};
        }
    }

    $CONFLICTS{$for} = \%conflicts;
    $DISTS{$for}     = $dist || $for;

    if (grep { $_ eq ':runtime' } @_) {
        for my $conflict (keys %conflicts) {
            $HAS_CONFLICTS{$conflict} ||= [];
            push @{ $HAS_CONFLICTS{$conflict} }, $for;
        }

        # warn for already loaded things...
        for my $conflict (keys %conflicts) {
            if (exists $INC{module_notional_filename($conflict)}) {
                _check_version([$for], $conflict);
            }
        }

        # and warn for subsequently loaded things...
        @INC = grep {
            !(ref($_) eq 'ARRAY' && @$_ > 1 && $_->[1] == \%CONFLICTS)
        } @INC;
        unshift @INC, [
            sub {
                my ($sub, $file) = @_;

                (my $mod = $file) =~ s{\.pm$}{};
                $mod =~ s{/}{::}g;
                return unless $mod =~ /[\w:]+/;

                return unless defined $HAS_CONFLICTS{$mod};

                {
                    local $HAS_CONFLICTS{$mod};
                    require $file;
                }

                _check_version($HAS_CONFLICTS{$mod}, $mod);

                # the previous require already handled it
                my $called;
                return sub {
                    return 0 if $called;
                    $_ = "1;";
                    $called = 1;
                    return 1;
                };
            },
            \%CONFLICTS, # arbitrary but unique, see above
        ];
    }

    $pkg->export_to_level(1, @_);
}

sub _strip_opt {
    my ($opt, @args) = @_;

    my $val;
    for my $idx ( 0 .. $#args - 1 ) {
        if (defined $args[$idx] && $args[$idx] eq $opt) {
            $val = (splice @args, $idx, 2)[1];
            last;
        }
    }

    return ( $val, @args );
}

sub _check_version {
    my ($fors, $mod) = @_;

    for my $for (@$fors) {
        my $conflict_ver = $CONFLICTS{$for}{$mod};
        my $version = do {
            no strict 'refs';
            ${ ${ $mod . '::' }{VERSION} };
        };

        if ($version le $conflict_ver) {
            warn <
Conflict detected for $DISTS{$for}:
  $mod is version $version, but must be greater than version $conflict_ver
EOF
            return;
        }
    }
}


sub conflicts {
    my $package = shift;
    return %{ $CONFLICTS{ $package } };
}


sub dist {
    my $package = shift;
    return $DISTS{ $package };
}


sub check_conflicts {
    my $package = shift;
    my $dist = $package->dist;
    my @conflicts = $package->calculate_conflicts;
    return unless @conflicts;

    my $err = "Conflicts detected for $dist:\n";
    for my $conflict (@conflicts) {
        $err .= "  $conflict->{package} is version "
                . "$conflict->{installed}, but must be greater than version "
                . "$conflict->{required}\n";
    }
    die $err;
}


sub calculate_conflicts {
    my $package = shift;
    my %conflicts = $package->conflicts;

    my @ret;


    CONFLICT:
    for my $conflict (keys %conflicts) {
        my $success = do {
            local $SIG{__WARN__} = sub {};
            eval { require_module($conflict) };
        };
        my $error = $@;
        my $file = module_notional_filename($conflict);
        next if not $success and $error =~ /Can't locate \Q$file\E in \@INC/;

        warn "Warning: $conflict did not compile" if not $success;
        my $installed = $success ? $conflict->VERSION : 'unknown';
        push @ret, {
            package   => $conflict,
            installed => $installed,
            required  => $conflicts{$conflict},
        } if not $success or $installed le $conflicts{$conflict};
    }

    return sort { $a->{package} cmp $b->{package} } @ret;
}


1;

__END__