kiwiroy / devel-iperl-plugin-perlbrew Goto Github PK
View Code? Open in Web Editor NEWLicense: GNU General Public License v3.0
License: GNU General Public License v3.0
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
If a program, such as git
is not available and a dependency is from a git repository App::Cpanminus::script::run
fails.
IPerl->load_plugin('CpanMinus') unless IPerl->can('cpanm');
IPerl->perlbrew_lib_create('notebook-example');
IPerl->perlbrew('notebook-example');
IPerl->cpanm_installdeps('.');
A declarative, efficient, and flexible JavaScript library for building user interfaces.
๐ Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
An Open Source Machine Learning Framework for Everyone
The Web framework for perfectionists with deadlines.
A PHP framework for web artisans
Bring data to life with SVG, Canvas and HTML. ๐๐๐
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
Some thing interesting about web. New door for the world.
A server is a program made to process requests and deliver data to clients.
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
Some thing interesting about visualization, use data art
Some thing interesting about game, make everyone happy.
We are working to build community through open source technology. NB: members must have two-factor auth.
Open source projects and samples from Microsoft.
Google โค๏ธ Open Source for everyone.
Alibaba Open Source for everyone
Data-Driven Documents codes.
China tencent open source team.