New upstream version 0.83

9 files changed, 87 insertions, 4 deletions

diff --git a/t/13.perl_release.t b/t/13.perl_release.t
index 8274e25..766d417 100644
--- a/t/13.perl_release.t
+++ b/t/13.perl_release.t
@@ -10,6 +10,7 @@ use File::Temp qw(tempdir);
 use Test::Spec;
 use Test::Exception;
 use CPAN::Perl::Releases;
+use JSON::PP qw(encode_json);
 
 describe "App::perlbrew#perl_release method" => sub {
     describe "given a valid perl version" => sub {
@@ -31,14 +32,16 @@ describe "App::perlbrew#perl_release method" => sub {
 
         my $orig_sub = \&CPAN::Perl::Releases::perl_tarballs;
         *App::perlbrew::http_get = sub {
-            return qq{<a href="/CPAN/authors/id/SOMEONE/perl-${version}.tar.gz">Download</a>};
+            return encode_json({hits => {hits => [{_source =>
+                {download_url => "https://cpan.metacpan.org/authors/id/SOMEONE/perl-${version}.tar.gz"}
+            }]}});
         };
         *CPAN::Perl::Releases::perl_tarballs = sub {};
 
         my $app = App::perlbrew->new;
         my ($ball, $url) = $app->perl_release($version);
         like $ball, qr/^perl-?${version}.tar.(bz2|gz)$/, $ball;
-        like $url, qr#^https?://search\.cpan\.org/CPAN/authors/id/SOMEONE/${ball}$#, $url;
+        like $url, qr#^https?://cpan\.metacpan\.org/authors/id/SOMEONE/${ball}$#, $url;
 
         *CPAN::Perl::Releases::perl_tarballs = $orig_sub;
     };
diff --git a/t/command-available.t b/t/command-available.t
index 06abd9b..c99bbcc 100644
--- a/t/command-available.t
+++ b/t/command-available.t
@@ -36,7 +36,7 @@ my %available_perls = (
 
 describe "available command output, when nothing installed locally," => sub {
     it "should display a list of perl versions" => sub {
-        my $app = App::perlbrew->new("available");
+        my $app = App::perlbrew->new("available", '--verbose');
         $app->expects( 'available_perls_with_urls' )->returns( \%available_perls );
 
         stdout_like sub { $app->run(); }, qr/^\s{3,}c?perl-?\d\.\d{1,3}[_.]\d{1,2}\s+(available from)\s+<https?:\/\/.+>/, 'Cannot find Perl in output'
@@ -45,7 +45,7 @@ describe "available command output, when nothing installed locally," => sub {
 
 describe "available command output, when something installed locally," => sub {
     it "should display a list of perl versions, with markers on installed versions" => sub {
-        my $app = App::perlbrew->new("available");
+        my $app = App::perlbrew->new("available", '--verbose');
 
 
         my @installed_perls = (
diff --git a/t/command-exec.t b/t/command-exec.t
index 2d2df56..2d2df56 100755..100644
--- a/t/command-exec.t
+++ b/t/command-exec.t
diff --git a/t/current_shell.t b/t/current_shell.t
new file mode 100644
index 0000000..182af39
--- /dev/null
+++ b/t/current_shell.t
@@ -0,0 +1,23 @@
+use warnings;
+use strict;
+use Test::More tests => 6;
+use App::perlbrew;
+
+my $current_shell = (split("/", $ENV{SHELL}))[-1];
+my $self = App::perlbrew->new();
+is($self->current_shell(), $current_shell, 'current_shell gives the expected shell based on $SHELL environment variable') or diag("\$SHELL = $ENV{SHELL}");
+is($self->current_shell('foobar'), 'foobar', 'current_shell setups and returns anything passed as parameter');
+
+for my $shell (qw(bash zsh)) {
+    note("Testing with $shell");
+    $self->current_shell($shell);
+    ok($self->current_shell_is_bashish(), 'current_shell_is_bashish() returns true if the current shell is Bash or based on it');
+}
+
+
+for my $shell (qw(ksh sh)) {
+    note("Testing with $shell");
+    $self->current_shell($shell);
+    is($self->current_shell_is_bashish(), 0, 'current_shell_is_bashish() returns false');
+}
+
diff --git a/t/fake-bin/curl b/t/fake-bin/curl
index c2915b2..c2915b2 100755..100644
--- a/t/fake-bin/curl
+++ b/t/fake-bin/curl
diff --git a/t/get_blead_perl.t b/t/get_blead_perl.t
new file mode 100644
index 0000000..c1c07a5
--- /dev/null
+++ b/t/get_blead_perl.t
@@ -0,0 +1,34 @@
+use warnings;
+use strict;
+use Test::More tests => 6;
+use App::perlbrew;
+use Test::TempDir::Tiny 0.016;
+
+my $dir = tempdir();
+mkdir("$dir/build");
+mkdir("$dir/build/blead");
+touch( "$dir/build/blead", 'OYFTV_51234' );
+touch( "$dir/build/blead", 'Hwefwo8124' );
+touch( "$dir/build/blead", 'perl-blead-hsf743r' );
+my $blead = 'perl-blead-e7e8ce8';
+mkdir("$dir/build/blead/$blead");
+
+my @content;
+my $found_dir = App::perlbrew::search_blead_dir( "$dir/build", \@content );
+is( $found_dir,       undef, 'no candidate directory is found' );
+is( scalar(@content), 1,     'there are only directories on content cache' );
+is( $content[0], 'blead', 'have the expected directory in the content cache' );
+$found_dir = App::perlbrew::search_blead_dir( "$dir/build/blead", \@content );
+is( $found_dir,       $blead, 'the expected directory is found' );
+is( scalar(@content), 1,      'there are only directories on content cache' );
+is( $content[0], $blead, 'have the expected directory in the content cache' );
+
+# creating files to make sure search_blead_dir only considers directories
+sub touch {
+    my ( $dir, $file ) = @_;
+    my $path = "$dir/$file";
+    open( my $out, '>', $path ) or die "Cannot create $path: $!";
+    print $out '...';
+    close($out);
+}
+
diff --git a/t/installation3.t b/t/installation3.t
index 8756c88..8756c88 100755..100644
--- a/t/installation3.t
+++ b/t/installation3.t
diff --git a/t/joinpath.t b/t/joinpath.t
new file mode 100644
index 0000000..bc139aa
--- /dev/null
+++ b/t/joinpath.t
@@ -0,0 +1,12 @@
+use warnings;
+use strict;
+use Test::More tests => 3;
+use Test::Exception;
+use App::perlbrew;
+
+my @long_path = qw(this is a long path to check if it is joined ok);
+unshift(@long_path, '');
+is(App::perlbrew::joinpath(@long_path), '/this/is/a/long/path/to/check/if/it/is/joined/ok', 'we got the expected path');
+$long_path[3] = undef;
+dies_ok { App::perlbrew::joinpath(@long_path) } 'dies if a undefined parameter is received';
+like($@, qr/^Received an undefined entry as a parameter/, 'dies with expected message');
diff --git a/t/splitpath.t b/t/splitpath.t
new file mode 100644
index 0000000..dfad9ce
--- /dev/null
+++ b/t/splitpath.t
@@ -0,0 +1,11 @@
+use warnings;
+use strict;
+use Test::More tests => 3;
+use Test::Exception;
+use App::perlbrew;
+
+my @long_path = qw(this is a long path to check if it is joined ok);
+unshift(@long_path, '');
+is(App::perlbrew::splitpath('/this/is/a/long/path/to/check/if/it/is/joined/ok'), @long_path, 'we got the expected path');
+dies_ok { App::perlbrew::splitpath(undef) } 'dies if a undefined parameter is received';
+like($@, qr/^Cannot receive an undefined path as parameter/, 'dies with expected message');