view release on metacpan or  search on metacpan

lib/Devel/IPerl/Plugin/EnvironmentModules.pm  view on Meta::CPAN

package Devel::IPerl::Plugin::EnvironmentModules;

use strict;
use warnings;
use Capture::Tiny ();
use Array::Diff ();
use Env::Modulecmd ();
use constant MODULECMD => $ENV{'PERL_MODULECMD'} || 'modulecmd';

our $VERSION = '0.03';

sub avail {
  my @args = (MODULECMD, qw{perl avail});
  my ($stderr, @result) = Capture::Tiny::capture_stderr { system { $args[0] } @args };
  return $stderr;
}

sub load  {
  shift->_env_diff(sub { local ($^W) = 1; Env::Modulecmd::_modulecmd('load', @_); }, @_);
}

sub list  {
  my @args = (MODULECMD, qw{perl list});
  my ($stderr, @result) = Capture::Tiny::capture_stderr { system { $args[0] } @args };
  return $stderr;
}

sub list_array {
  my $self  = shift;
  my @lines = split m{\n}, $self->list || '';
  return [
    grep { length }
    map  { split m{(?:\s*\d+\)\s)} } @lines[1.. $#lines]
    ];
}

sub new   { bless {}, ref($_[0]) || $_[0]; }

sub register {
    my ($class, $iperl) = @_;
    my $self = $class->new;
    for my $name(qw{avail load unload list list_array search show}) {
      $iperl->helper("module_$name" => sub {
          my ($ip, $ret) = (shift, -1);
          return $ret if $name =~ /^(load|search|show|unload)$/ && @_ == 0;
          my $cb = $self->can($name);
          return $ret unless $cb;
          return $self->$cb(@_);
      });
    }
    return 1;
}

sub search {
  my ($self, $query) = @_;
  my $regex = ref($query) eq 'Regexp' ? $query : qr{\Q$query\E};
  my $hits  =
    join $/ => sort { lc($a) cmp lc($b) }
      grep { m/$regex/ } split m{(?:$/|\s+)}, $self->avail || '';
  return $hits || 'no match';
}

sub show {
  shift;
  my @args = (MODULECMD, qw{perl show}, @_);
  my ($stderr, @result) = Capture::Tiny::capture_stderr { system { $args[0] } @args };
  return $stderr;
}

sub unload {
  shift->_env_diff(sub { local ($^W) = 1; Env::Modulecmd::_modulecmd('unload', @_); }, @_);
}

## like around, but explicitly called.
sub _env_diff {
  my ($self, $orig) = (shift, shift);
  my %before = %ENV; # shallow copy

  my $ret = $orig->(@_);

  if (($before{PERL5LIB} || '') ne ($ENV{PERL5LIB} || '')) {
    my $old = [ split /:/, $before{PERL5LIB} || '' ];
    my $new = [ split /:/, $ENV{PERL5LIB}    || '' ];
    my $ad  = Array::Diff->new;
    $ad->diff($old, $new);
    ## add or remove with lib
    eval "use lib q[$_];" for (@{$ad->added});
    eval "no lib q[$_];" for (@{$ad->deleted});
  }

  return $ret;
}

1;

=pod

=head1 NAME

Devel::IPerl::Plugin::EnvironmentModules - Environment Modules

=begin html

<!-- Travis -->
<a href="https://travis-ci.org/kiwiroy/Devel-IPerl-Plugin-EnvironmentModules">
  <img src="https://travis-ci.org/kiwiroy/Devel-IPerl-Plugin-EnvironmentModules.svg?branch=master"
       alt="Build Status" />
</a>

<!-- Coveralls -->
<a href="https://coveralls.io/github/kiwiroy/Devel-IPerl-Plugin-EnvironmentModules?branch=master">
  <img src="https://coveralls.io/repos/github/kiwiroy/Devel-IPerl-Plugin-EnvironmentModules/badge.svg?branch=master"
       alt="Coverage Status" />
</a>

<!-- Kritika -->
<a href="https://kritika.io/users/kiwiroy/repos/6049167555239475/heads/master/">
  <img src="https://kritika.io/users/kiwiroy/repos/6049167555239475/heads/master/status.svg"
       alt="Kritika Analysis Status" />