Skip to content
Browse files

perlbrew available works, this time without extra dependancies

  • Loading branch information...
1 parent 3fc0da8 commit 1756258fba18aa646df876c12d2cb24015f48529 @trcjr trcjr committed Apr 5, 2011
Showing with 175 additions and 72 deletions.
  1. +0 −3 Makefile.PL
  2. +13 −19 lib/App/perlbrew.pm
  3. +29 −24 perlbrew
  4. +3 −26 t/03.test_get_available_versions.t
  5. +130 −0 t/04.find_available_perls.t
View
3 Makefile.PL
@@ -48,11 +48,8 @@ all_from 'lib/App/perlbrew.pm';
repository 'git://github.com/gugod/App-perlbrew.git';
-requires 'HTML::TableExtract' => 2.10;
-requires 'HTML::Entities';
test_requires 'Test::Simple';
test_requires 'Test::More';
-test_requires 'Test::MockObject::Extends';
test_requires 'Test::Output';
install_script 'bin/perlbrew';
View
32 lib/App/perlbrew.pm
@@ -4,7 +4,6 @@ use warnings;
use 5.008;
use Getopt::Long ();
use File::Spec::Functions qw( catfile );
-use HTML::Entities;
our $VERSION = "0.15_99";
our $CONF;
@@ -278,7 +277,7 @@ sub run_command_available {
for my $installed (@installed) {
my $name = $installed->{name};
my $cur = $installed->{is_current};
- if ( $available eq $installed ) {
+ if ( $available eq $installed->{name} ) {
$is_installed = 1;
last;
}
@@ -289,26 +288,18 @@ sub run_command_available {
sub get_available_perls {
my ( $self, $dist, $opts ) = @_;
- my $mirror = $self->conf->{mirror};
-
- my $url = "http://www.cpan.org/";
- $url = $mirror->{url} if defined( $mirror->{url} );
- my $path = "/src/README.html";
- $url = $url . $path;
- my $html = http_get( decode_entities($url), undef, undef );
- use HTML::TableExtract;
- my $te = HTML::TableExtract->new( headers => [qw(Release File Type Age)] );
- $te->parse($html);
+
+ my $url = "http://www.cpan.org/src/README.html";
+ my $html = http_get( $url, undef, undef );
+
my @available_versions;
- foreach my $ts ( $te->tables ) {
- foreach my $row ( $ts->rows ) {
- my @a = split( ',', @$row[1] );
- my $p = $a[0];
- $p =~ s/\.tar\.gz$//;
- push @available_versions, $p;
- }
+ for ( split "\n", $html ) {
+ push @available_versions, $3
+ if m|<tr><td>(.*)</td><td>(.*)</td><td><a href="(.*?)">|;
}
+ s/\.tar\.gz// for @available_versions;
+
return @available_versions;
}
@@ -829,6 +820,9 @@ App::perlbrew - Manage perl installations in your $HOME
# Pick a preferred CPAN mirror
perlbrew mirror
+ # See what is available
+ perlbrew available
+
# Install some Perls
perlbrew install perl-5.12.2
perlbrew install perl-5.8.1
View
53 perlbrew
@@ -6,9 +6,8 @@ use warnings;
use 5.008;
use Getopt::Long ();
use File::Spec::Functions qw( catfile );
-use HTML::Entities;
-our $VERSION = "0.15";
+our $VERSION = "0.15_99";
our $CONF;
my $ROOT = $ENV{PERLBREW_ROOT} || "$ENV{HOME}/perl5/perlbrew";
@@ -196,6 +195,8 @@ sub new {
'D=s@',
'U=s@',
'A=s@',
+
+ 'j=i'
)
or run_command_help(1);
@@ -278,7 +279,7 @@ sub run_command_available {
for my $installed (@installed) {
my $name = $installed->{name};
my $cur = $installed->{is_current};
- if ( $available eq $installed ) {
+ if ( $available eq $installed->{name} ) {
$is_installed = 1;
last;
}
@@ -289,26 +290,18 @@ sub run_command_available {
sub get_available_perls {
my ( $self, $dist, $opts ) = @_;
- my $mirror = $self->conf->{mirror};
-
- my $url = "http://www.cpan.org/";
- $url = $mirror->{url} if defined( $mirror->{url} );
- my $path = "/src/README.html";
- $url = $url . $path;
- my $html = http_get( decode_entities($url), undef, undef );
- use HTML::TableExtract;
- my $te = HTML::TableExtract->new( headers => [qw(Release File Type Age)] );
- $te->parse($html);
+
+ my $url = "http://www.cpan.org/src/README.html";
+ my $html = http_get( $url, undef, undef );
+
my @available_versions;
- foreach my $ts ( $te->tables ) {
- foreach my $row ( $ts->rows ) {
- my @a = split( ',', @$row[1] );
- my $p = $a[0];
- $p =~ s/\.tar\.gz$//;
- push @available_versions, $p;
- }
+ for ( split "\n", $html ) {
+ push @available_versions, $3
+ if m|<tr><td>(.*)</td><td>(.*)</td><td><a href="(.*?)">|;
}
+ s/\.tar\.gz// for @available_versions;
+
return @available_versions;
}
@@ -492,7 +485,18 @@ INSTALL
$configure_flags = '-de';
}
- my @install = $self->{notest} ? "make install" : ("make test", "make install");
+ # Test via "make test_harness" if available so we'll get
+ # automatic parallel testing via $HARNESS_OPTIONS. The
+ # "test_harness" target was added in 5.7.3, which was the last
+ # development release before 5.8.0.
+ my $test_target = "test";
+ if ($dist_version =~ /^5\.(\d+)\.(\d+)/
+ && ($1 >= 8 || $1 == 7 && $2 == 3)) {
+ $test_target = "test_harness";
+ }
+
+ my $make = "make " . ($self->{j} ? "-j$self->{j}" : "");
+ my @install = $self->{notest} ? "make install" : ("make $test_target", "make install");
@install = join " && ", @install unless($self->{force});
my $cmd = join ";",
@@ -510,7 +514,8 @@ INSTALL
&& ($1 < 8 || $1 == 8 && $2 < 9)
? ("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile")
: (),
- "make", @install
+ $make,
+ @install
);
$cmd = "($cmd) >> '$self->{log_file}' 2>&1 "
if ( $self->{quiet} && !$self->{verbose} );
@@ -706,7 +711,7 @@ sub run_command_env {
my %env = $self->perlbrew_env($perl);
- if ($self->env('SHELL') =~ /(ba|z)sh$/) {
+ if ($self->env('SHELL') =~ /(ba|z|\/)sh$/) {
while (my ($k, $v) = each(%env)) {
print "export $k=$v\n";
}
@@ -823,8 +828,8 @@ perlbrew - Perl Environment manager.
perlbrew <command> [options] [arguments]
Commonly used commands:
- available List available perls
init Initialize perlbrew environment.
+ available List availalbe perls
install Install perl
list List installed perls
use Use the specified perl in current shell
View
29 t/03.test_get_available_versions.t
@@ -1,17 +1,9 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use lib qw(lib);
-use English qw( -no_match_vars );
use Test::More;
-use Test::MockObject::Extends;
-use Data::Dumper;
-
use App::perlbrew;
-my $app = App::perlbrew->new();
-$app = Test::MockObject::Extends->new($app);
-
my $html = <<END_HTML;
<table border="1">
<tbody><tr><th></th><td>Release</td><td>File</td><td>Type</td><td>Age</td>
@@ -26,32 +18,17 @@ my $html = <<END_HTML;
</tbody></table>
END_HTML
-sub _mock_conf {
- my ($self) = shift;
- return {
- 'mirror' => {
- 'name' => 'North America, United States,Virginia, Dulles '
- . '(cpan-du.viaverio.com)',
- 'url' => '&#104;&#116;&#116;&#112;://&#99;&#112;&#97;&#110;'
- . '-&#100;&#117;.&#118;&#105;&#97;&#118;&#101;&#114;&#105;'
- . '&#111;.&#99;&#111;&#109;/'
- }
- };
-}
+my $app = App::perlbrew->new();
is scalar $app->get_available_perls(), 8, "Correct number of releases found";
my @known_perl_versions = (
- 'perl-5.13.8', 'perl-5.12.2', 'perl-5.10.1', 'perl-5.8.9',
- 'perl-5.6.2', 'perl5.005_04', 'perl5.004_05', 'perl5.003_07'
+ 'perl-5.13.11', 'perl-5.12.3', 'perl-5.10.1', 'perl-5.8.9',
+ 'perl-5.6.2', 'perl5.005_04', 'perl5.004_05', 'perl5.003_07'
);
for my $perl_version ( $app->get_available_perls() ) {
ok grep( $_ eq $perl_version, @known_perl_versions ), "$perl_version found";
}
-$app->mock( 'conf', \&_mock_conf );
-
-is scalar $app->get_available_perls(), 8, "Correct number of releases found";
-
done_testing();
View
130 t/04.find_available_perls.t
@@ -0,0 +1,130 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+use App::perlbrew;
+
+my $html = <<HERE;
+<!-- LATEST_RELEASES -->
+<table border="1">
+<tr><th>Release</th><th>File</th><th>Type</th><th>Age</th></tr>
+<tr><td>5.13</td><td>5.13.11</td><td><a href="perl-5.13.11.tar.gz">perl-5.13.11.tar.gz</a>, <a href="perl-5.13.11.tar.bz2">perl-5.13.11.tar.bz2</a></td><td>devel</td><td>14 days</td></tr>
+<tr><td>5.12</td><td>5.12.3</td><td><a href="perl-5.12.3.tar.gz">perl-5.12.3.tar.gz</a>, <a href="perl-5.12.3.tar.bz2">perl-5.12.3.tar.bz2</a></td><td>maint</td><td>2 months, 11 days</td></tr>
+<tr><td>5.10</td><td>5.10.1</td><td><a href="perl-5.10.1.tar.gz">perl-5.10.1.tar.gz</a>, <a href="perl-5.10.1.tar.bz2">perl-5.10.1.tar.bz2</a></td><td>maint</td><td>1 year, 7 months</td></tr>
+<tr><td>5.8</td><td>5.8.9</td><td><a href="perl-5.8.9.tar.gz">perl-5.8.9.tar.gz</a>, <a href="perl-5.8.9.tar.bz2">perl-5.8.9.tar.bz2</a></td><td>maint</td><td>2 years, 3 months</td></tr>
+<tr><td>5.6</td><td>5.6.2</td><td><a href="perl-5.6.2.tar.gz">perl-5.6.2.tar.gz</a></td><td>maint</td><td>7 years, 4 months</td></tr>
+<tr><td>5.5</td><td>5.5.4</td><td><a href="perl5.005_04.tar.gz">perl5.005_04.tar.gz</a></td><td>maint</td><td>7 years, 1 month</td></tr>
+<tr><td>5.4</td><td>5.4.5</td><td><a href="perl5.004_05.tar.gz">perl5.004_05.tar.gz</a></td><td>maint</td><td>11 years, 11 months</td></tr>
+<tr><td>5.3</td><td>5.3.7</td><td><a href="perl5.003_07.tar.gz">perl5.003_07.tar.gz</a></td><td>maint</td><td>14 years, 5 months</td></tr>
+</table>
+
+<p><small>(A year is 365.2425 days and a month is 30.436875 days.)</small></p>
+HERE
+
+my @expected_releases = (
+ {
+ 'file' => 'perl-5.13.11.tar.gz',
+ 'type' => 'devel',
+ 'release' => '5.13.11',
+ 'age' => '14 days',
+ 'branch' => '5.13'
+ },
+ {
+ 'file' => 'perl-5.12.3.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.12.3',
+ 'age' => '2 months, 11 days',
+ 'branch' => '5.12'
+ },
+ {
+ 'file' => 'perl-5.10.1.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.10.1',
+ 'age' => '1 year, 7 months',
+ 'branch' => '5.10'
+ },
+ {
+ 'file' => 'perl-5.8.9.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.8.9',
+ 'age' => '2 years, 3 months',
+ 'branch' => '5.8'
+ },
+ {
+ 'file' => 'perl-5.6.2.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.6.2',
+ 'age' => '7 years, 4 months',
+ 'branch' => '5.6'
+ },
+ {
+ 'file' => 'perl5.005_04.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.5.4',
+ 'age' => '7 years, 1 month',
+ 'branch' => '5.5'
+ },
+ {
+ 'file' => 'perl5.004_05.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.4.5',
+ 'age' => '11 years, 11 months',
+ 'branch' => '5.4'
+ },
+ {
+ 'file' => 'perl5.003_07.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.3.7',
+ 'age' => '14 years, 5 months',
+ 'branch' => '5.3'
+ },
+ {
+ 'file' => 'perl5.003_07.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.3.7',
+ 'age' => '14 years, 5 months',
+ 'branch' => '5.3'
+ },
+ {
+ 'file' => 'perl5.003_07.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.3.7',
+ 'age' => '14 years, 5 months',
+ 'branch' => '5.3'
+ },
+ {
+ 'file' => 'perl5.003_07.tar.gz',
+ 'type' => 'maint',
+ 'release' => '5.3.7',
+ 'age' => '14 years, 5 months',
+ 'branch' => '5.3'
+ }
+);
+my $app = App::perlbrew->new();
+
+my @releases = ();
+for my $line ( split "\n", $html ) {
+ $line =~
+m|<tr><td>(.*)</td><td>(.*)</td><td><a href="(.*?)">.*<td>(.*)</td><td>(.*)</td>|;
+ push @releases,
+ { branch => $1, release => $2, file => $3, type => $4, age => $5 }
+ if ( $1 && $2 && $3 && $4 && $5 );
+}
+
+is @releases => 11, 'found 11 releases';
+is $releases[0]->{branch} => 5.13, '5.13 branch';
+
+#is $releases[0]->{release} => 5.13, '5.13 branch';
+
+TEST:
+for my $i ( 0 .. scalar @releases - 1 - 1 ) {
+ is $releases[$i]->{branch} => $expected_releases[$i]->{branch}, "branch " . $releases[$i]->{branch} . " found";
+ is $releases[$i]->{release} => $expected_releases[$i]->{release}, "release " . $releases[$i]->{release} . " found";
+ is $releases[$i]->{file} => $expected_releases[$i]->{file}, "file " . $releases[$i]->{file} . " found";
+ is $releases[$i]->{type} => $expected_releases[$i]->{type}, "type " . $releases[$i]->{type} . " found";
+ is $releases[$i]->{age} => $expected_releases[$i]->{age}, "age " . $releases[$i]->{age} . " found";
+}
+done_testing();
+

0 comments on commit 1756258

Please sign in to comment.
Something went wrong with that request. Please try again.