-
Notifications
You must be signed in to change notification settings - Fork 0
License
kiwiroy/Devel-IPerl-Plugin-Perlbrew
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Folders and files
Name | Name | Last commit message | Last commit date | |
---|---|---|---|---|
Repository files navigation
package Devel::IPerl::Plugin::Perlbrew; use strict; use warnings; use feature 'say'; use Symbol 'delete_package'; use constant DEBUG => $ENV{IPERL_PLUGIN_PERLBREW_DEBUG} ? 1 : 0; use constant PERLBREW_CLASS => $ENV{IPERL_PLUGIN_PERLBREW_CLASS} ? $ENV{IPERL_PLUGIN_PERLBREW_CLASS} : 'App::perlbrew'; use constant PERLBREW_INSTALLED => eval 'use '. PERLBREW_CLASS.'; 1' ? 1 : 0; our $VERSION = '0.04'; sub brew { my $self = shift; my %env = %{$self->env || {}}; my %save = (); for my $var(_filtered_env_keys(\%env)) { say STDERR "@$self{name} ", join " = ", $var, $env{$var} if DEBUG; $save{$var} = $ENV{$var} if exists $ENV{$var}; $ENV{$var} = $env{$var}; } if ($env{PERL5LIB}) { say STDERR join " = ", 'PERL5LIB', $env{'PERL5LIB'} if DEBUG; eval "use lib split ':', q[$env{PERL5LIB}];"; warn $@ if $@; ## uncoverable branch true } return $self->saved(\%save); } sub env { return $_[0]{env} if @_ == 1; $_[0]{env} = $_[1]; $_[0]; } sub new { my $class = shift; bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class; } sub name { return $_[0]{name} if @_ == 1; $_[0]{name} = $_[1]; $_[0]; } sub register { my ($class, $iperl) = @_; my $domain = sub { my $instance = $_[0]->instance; return $instance->{'perlbrew_domain'} if @_ == 1; $instance->{'perlbrew_domain'} = $_[1]; $instance; }; $domain->($iperl, $ENV{'PERLBREW_HOME'}); for my $name (qw{perlbrew}) { my $current = $class->new->name('@@@'); ## impossible name $iperl->helper($name => sub { my ($ip, $lib, $unload, $ret) = (shift, shift, shift || 0, -1); return $ret if not defined $lib; return $ret if 0 == PERLBREW_INSTALLED; my $new = $class->new->name($class->_make_name($lib, $domain->($ip))); if ($current->unload($unload)->name ne $new->name) { my $pb = PERLBREW_CLASS->new(); $pb->home($domain->($ip)); $new->env({ $pb->perlbrew_env($new->name) }); ## ensure the timing of the DESTROY, spoil undef($current = $current->spoil); $current = $new->brew; } return $new->success; }); } for my $name (qw{list list_modules}) { $iperl->helper("perlbrew_$name" => sub { my ($ip, $ret) = (shift, -1); return $ret if 0 == PERLBREW_INSTALLED; my $pb = PERLBREW_CLASS->new(); $pb->home($domain->($ip)); local $App::perlbrew::PERLBREW_HOME = $pb->home if ($name eq 'list_modules'); return $pb->run_command($name, @_); }); } for my $name (qw{lib_create}) { $iperl->helper("perlbrew_$name" => sub { my ($ip, $lib, $ret) = (shift, shift, -1); return $ret if not defined $lib; return $ret if 0 == PERLBREW_INSTALLED; my $pb = PERLBREW_CLASS->new(); $pb->home($domain->($ip)); eval { $pb->run_command_lib_create($class->_make_name($lib, $domain->($ip))); }; return $@ ? 0 : 1; }); } $iperl->helper('perlbrew_domain' => sub { my ($ip, $dir) = (shift, shift); return $domain->($ip) unless $dir && -d $dir; return $domain->($ip, $dir)->{'perlbrew_domain'}; }); return 1; } sub saved { return $_[0]{saved} if @_ == 1; $_[0]{saved} = $_[1]; $_[0]; } sub spoil { my $self = shift; my %env = %{$self->env || {}}; my %save = %{$self->saved || {}}; for my $var(_filtered_env_keys(\%env)) { if (exists $save{$var}) { say STDERR "revert ", join " = ", $var, $save{$var} if DEBUG; $ENV{$var} = $save{$var}; } else { say STDERR "unset ", $var if DEBUG; delete $ENV{$var}; } } if ($env{PERL5LIB}) { say STDERR join " = ", 'PERL5LIB', $env{'PERL5LIB'} if DEBUG; eval "no lib split ':', q[$env{PERL5LIB}];"; warn $@ if $@; ## uncoverable branch true if ($self->unload) { my $path_re = qr{\Q$env{PERL5LIB}\E}; for my $module_path(keys %INC) { ## autosplit modules next if $module_path =~ m{\.(al|ix)$} && delete $INC{$module_path}; ## global destruction ? next if not defined $INC{$module_path}; ## FatPacked ? next if ref($INC{$module_path}); ## Not part of this PERL5LIB next if $INC{$module_path} !~ m{^$path_re}; ## translate to class_path (my $class = $module_path) =~ s{/}{::}g; $class =~ s/\.pm//; ## notify and unload say "unloading $class ($module_path) from $INC{$module_path}"; _teardown( $class ); delete $INC{$module_path}; } } } # no need to revert again. return $self->env({})->saved({}); } sub success { scalar(keys %{$_[0]->{env}}) ? 1 : 0; } sub unload { return $_[0]{unload} if @_ == 1; $_[0]{unload} = $_[1]; $_[0]; } sub _check_env_perl { my ($env_perl, $path_perl) = (shift, _from_binary_path()); $ENV{PERLBREW_PERL} = $env_perl = $path_perl unless $env_perl; return $env_perl unless $path_perl; return ($env_perl eq $path_perl ? $env_perl : $ENV{PERLBREW_PERL} = $path_perl); } sub _filtered_env_keys { return (sort grep { m/^PERL/i && $_ ne "PERL5LIB" } keys %{+pop}); } sub _from_binary_path { say STDERR $^X if DEBUG; if ($^X =~ m{/perls/([^/]+)/bin/perl}) { return $1; } (my $v = $^V->normal) =~ s/v/perl-/; return $v; } sub _make_name { my ($class, $name, $current, $home) = (shift, shift, _check_env_perl($ENV{PERLBREW_PERL}), shift); my $pb = PERLBREW_CLASS->new(); $pb->home($home) if $home; my ($perl, $lib) = $pb->resolve_installation_name($name); if ((! defined($perl))){ if ($name =~ m/\@[^\@]+$/) { ($perl, $lib) = $pb->resolve_installation_name(join '@', $current, (split /\@/, $name)[1]); } elsif($name !~ /\@/ && $name !~ /^[\d\.]+$/){ ($perl, $lib) = $pb->resolve_installation_name(join '@', $current, $name); } } $perl = $class->_resolve_compat($pb, $perl, $current, $lib) || $current; return $perl unless $lib; return join '@', $perl, $lib; } sub _resolve_compat { my ($class, $pb, $perl, $current, $lib) = @_; return '' unless $lib; my @installed = $pb->installed_perls; # get the current perl and version my ($current_perl) = grep { $_->{name} eq $current } @installed; my $current_version = $current_perl->{comparable_version} || ''; my ($avail) = ( # filter the exact grep { $_->{perl_name} eq $perl && $_->{lib_name} eq $lib } # get the libraries only map { @{$_->{libs}} } # filter the compatible libraries grep { $_->{comparable_version} == $current_version } @installed ); #use Data::Dumper; #say STDERR Dumper $current_perl, $current_version, \@installed if DEBUG; return '' unless $avail; return $avail->{perl_name}; } ## from Mojo::Util sub _teardown { return unless my $class = shift; # @ISA has to be cleared first because of circular references no strict 'refs'; @{"${class}::ISA"} = (); delete_package $class; } sub DESTROY { my $self = shift; say STDERR "DESTROY $self @$self{name}" if DEBUG; $self->spoil; return ; } 1; =pod =head1 NAME Devel::IPerl::Plugin::Perlbrew - interact with L<perlbrew> in L<Jupyter|https://jupyter.org> IPerl kernel =begin html <!-- Travis --> <a href="https://travis-ci.org/kiwiroy/Devel-IPerl-Plugin-Perlbrew"> <img src="https://travis-ci.org/kiwiroy/Devel-IPerl-Plugin-Perlbrew.svg?branch=master" alt="Build Status" /> </a> <!-- Coveralls --> <a href='https://coveralls.io/github/kiwiroy/Devel-IPerl-Plugin-Perlbrew?branch=master'> <img src='https://coveralls.io/repos/github/kiwiroy/Devel-IPerl-Plugin-Perlbrew/badge.svg?branch=master' alt='Coverage Status' /> </a> <!-- Kritika --> <a href="https://kritika.io/users/kiwiroy/repos/6870682787977901/heads/master/"> <img src="https://kritika.io/users/kiwiroy/repos/6870682787977901/heads/master/status.svg" alt="Kritika Analysis Status"/> </a> <!-- CPAN --> <a href="https://badge.fury.io/pl/Devel-IPerl-Plugin-Perlbrew"> <img src="https://badge.fury.io/pl/Devel-IPerl-Plugin-Perlbrew.svg" alt="CPAN version" /> </a> =end html =head1 DESCRIPTION In a shared server environment the Perl module needs of multiple users can be met most easily with access to L<perlbrew> and the ability to install perl modules under their own libraries. A user can generate a L<cpanfile> to facilitate the creation of these libraries in a reproducible manner. At the command line a typical workflow in such an environment might appear thus: perlbrew lib create perl-5.26.0@reproducible perlbrew use perl-5.26.0@reproducible ## assuming a cpanfile cpanm --installdeps . During the analysis that utilises such codebases using a JupyterHub on the same environment a user will wish to access these installed modules in a way that is as simple as the command line and within the framework of a Jupyter notebook. This plugin is designed to easily transition between command line and Jupyter with similar syntax and little overhead. =begin html <p>There are some Jupyter notebooks in the <a href="./examples/">examples directory</a></p> =end html =head1 SYNOPSIS IPerl->load_plugin('Perlbrew') unless IPerl->can('perlbrew'); IPerl->perlbrew_list(); IPerl->perlbrew_list_modules(); IPerl->perlbrew('perl-5.26.0@reproducible'); =head1 INSTALLATION AND REQUISITES ## install dependencies cpanm --installdeps --quiet . ## install cpanm . If there are some issues with L<Devel::IPerl> installing refer to their L<README.md|https://github.com/EntropyOrg/p5-Devel-IPerl>. The C<.travis.yml> in this repository might provide sources of help. L<App::perlbrew> is a requirement and it is B<suggested> that L<Devel::IPerl> is deployed into a L<perlbrew> installed L<perl|perlbrew#COMMAND:-INSTALL> and call the L</"perlbrew"> function to use each L<library|perlbrew#COMMAND:-LIB>. =over 4 =item installing perlbrew For a single user use case the recommended install proceedure at L<https://perlbrew.pl> should be used. If installing for a shared environment and JupyterHub, the following may act as a template. version=0.82 mkdir -p /sw/perlbrew-$version export PERLBREW_ROOT=!$ curl -L https://install.perlbrew.pl | bash =item installing iperl The kernel specification needs to be installed so that Jupyter can find it. This is achieved thus: iperl --version =item perlbrew-ise the kernel The kernel specification should be updated to make the environment variables, that L<App::perlbrew> relies on, available. Included in this dist is the command C<perlbrewise-spec>. perlbrewise-spec =back =head1 IPerl Interface Method =head2 register Called by C<<< IPerl->load_plugin('Perlbrew') >>>. =head1 REGISTERED METHODS =head2 perlbrew # 1 - success IPerl->perlbrew('perl-5.26.0@reproducible'); # 0 - it is already loaded IPerl->perlbrew('perl-5.26.0@reproducible'); # -1 - no library specified IPerl->perlbrew(); # 1 - success switching off reproducible and reverting to perl-5.26.0 IPerl->perlbrew($ENV{'PERLBREW_PERL'}); This is identical to C<<< perlbrew use perl-5.26.0@reproducible >>> and will switch any from any previous call. Returns C<1>, C<0> or C<-1> for I<success>, I<no change> and I<error> respectively. A name for the library is required. To revert to the I<"system"> or non-library version pass the value of C<$ENV{PERLBREW_PERL}>. IPerl->perlbrew('perl-5.26.0@tutorial', 1); The function takes a Boolean as an optional second argument. A I<true> value will result in all the modules that were loaded during the activity of the previous library to be unloaded using L<delete_package|Symbol>. The default value is I<false> as setting is to true might expose the L<unexpected|Symbol#BUGS> behaviour. When using multiple L<perlbrew> libraries it may be possible to use modules from both, although this is not a recommended use. IPerl->perlbrew('perl-5.26.0@tutorial'); use Jupyter::Tutorial::Simple; ## run some code ## load @reproducible, but do not unload Jupyter::Tutorial::Simple IPerl->perlbrew('perl-5.26.0@reproducible', 0); use Bio::Taxonomy; ## ... more code, possibly using Jupyter::Tutorial::Simple =head2 perlbrew_domain B<This is experimental>. # /home/username/.perlbrew IPerl->perlbrew_domain; # /work/username/perlbrew-libs IPerl->perlbrew_domain('/work/username/perlbrew-libs'); Users often generate a large number of libraries which can quickly result in a long list generated in the output of L</"perlbrew_list">. This experimental feature allows for switching between I<domains> to reduce the size of these lists. Thus, a collection of libraries are organised under domains. These are only directories, must exist before use and are synonymous with C<$ENV{PERLBREW_HOME}>. Indeed, this is a convenient alternative to C<$App::perlbrew::PERLBREW_HOME>. =head2 perlbrew_lib_create # 1 - success IPerl->perlbrew_lib_create('reproducible'); # 0 - already exists IPerl->perlbrew_lib_create('reproducible'); # -1 - no library name given IPerl->perlbrew_lib_create(); This is identical to C<<< perlbrew lib create >>>. Returns C<1>, C<0> or C<-1> for I<success>, I<already exists> and I<error> respectively. =head2 perlbrew_list IPerl->perlbrew_list; This is identical to C<<< perlbrew list >>> and will output the same information. =head2 perlbrew_list_modules IPerl->perlbrew_list_modules; This is identical to C<<< perlbrew list_modules >>> and will output the same information. =head1 ENVIRONMENT VARIABLES The following environment variables alter the behaviour of the plugin. =over 4 =item IPERL_PLUGIN_PERLBREW_DEBUG A logical to control how verbose the plugin is during its activities. =item IPERL_PLUGIN_PERLBREW_CLASS This defaults to L<App::prelbrew> =back =head1 INTERNAL INTERFACES These are part of the internal interface and not designed for end user consumption. =head2 brew $plugin->brew; Use the perlbrew library specified in L</"name">. =head2 env $plugin->env({PERLBREW_ROOT => '/sw/perlbrew', ...}); # {PERLBREW_ROOT => '/sw/perlbrew', ...} $plugin->env; An accessor that stores the environment from L<App::perlbrew> for a subsequent call to L</"brew">. =head2 new my $plugin = Devel::IPerl::Plugin::Perlbrew->new(); Instantiate an object. =head2 name $plugin->name('perl-5.26.0@reproducible'); # perl-5.26.0@reproducible $plugin->name; An accessor for the name of the perlbrew library. =head2 saved $plugin->saved; An accessor for the previous environment variables so they may be restored as the L</"brew"> L</"spoil">s. =head2 spoil $plugin->spoil; When a L</"brew"> is finished with. This is called automatically during object destruction. =head2 success # boolean where 1 == success, 0 == not success $plugin->success; Was everything a success? =head2 unload $plugin->unload(1); # 1 $plugin->unload; A flag to determine whether to unload all the modules that were used as part of this library during cleanup. =cut
About
No description or website provided.
Topics
Resources
License
Stars
Watchers
Forks
Packages 0
No packages published