[libdist-zilla-role-bootstrap-perl] 02/06: Add alternative try_build_method mechanisms

Axel Beckert abe at deuxchevaux.org
Sat Aug 8 11:58:20 UTC 2015


This is an automated email from the git hooks/post-receive script.

abe pushed a commit to annotated tag 0.2.0-source
in repository libdist-zilla-role-bootstrap-perl.

commit a7e40d226cfea594a885cfddcedf215314cd6dd7
Author: Kent Fredric <kentfredric at gmail.com>
Date:   Sat Sep 21 20:43:38 2013 +1200

    Add alternative try_build_method mechanisms
---
 Changes                          |   5 ++
 README.mkdn                      |  12 ++++-
 dist.ini                         |   1 +
 lib/Dist/Zilla/Role/Bootstrap.pm | 100 +++++++++++++++++++++++++++++++++++----
 t/02-try-built-mtime.t           |  88 ++++++++++++++++++++++++++++++++++
 t/03-try-built-parseversion.t    |  89 ++++++++++++++++++++++++++++++++++
 6 files changed, 286 insertions(+), 9 deletions(-)

diff --git a/Changes b/Changes
index 96acd3b..c9246a2 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,11 @@
 Release history for Dist-Zilla-Role-Bootstrap
 
 {{$NEXT}}
+ [00 Major - try_built_method]
+ - New mechanisms for try_built if there is >1 build trees
+ - Default mechanism 'mtime' picks built dir with the most recent mtime
+ - Alternative mechanism attempts to parse versions out of build dirs and
+   use the latest
 
 0.1.0 2013-09-04T11:24:24Z
  - First version.
diff --git a/README.mkdn b/README.mkdn
index 6fff292..fe78c3a 100644
--- a/README.mkdn
+++ b/README.mkdn
@@ -4,7 +4,7 @@ Dist::Zilla::Role::Bootstrap - Shared logic for bootstrap things.
 
 # VERSION
 
-version 0.1.0
+version 0.2.0
 
 # SYNOPSIS
 
@@ -40,6 +40,8 @@ For users of plugins:
 
 ## `fallback`
 
+## `try_built_method`
+
 # PRIVATE ATTRIBUTES
 
 ## `_cwd`
@@ -48,6 +50,14 @@ For users of plugins:
 
 # PRIVATE METHODS
 
+## `_pick_latest_mtime`
+
+## `_get_candidate_version`
+
+## `_pick_latest_parseversion`
+
+## `_pick_candidate`
+
 ## `_add_inc`
 
 {
diff --git a/dist.ini b/dist.ini
index e4bab41..90b9bb6 100644
--- a/dist.ini
+++ b/dist.ini
@@ -6,6 +6,7 @@ copyright_holder = Kent Fredric <kentfredric at gmail.com>
 
 ; Uncomment this to bootstrap via self 
 ; [Bootstrap::lib]
+; try_built = 1
 
 [@Author::KENTNL]
 :version          = 1.2.0
diff --git a/lib/Dist/Zilla/Role/Bootstrap.pm b/lib/Dist/Zilla/Role/Bootstrap.pm
index 115b92a..a40eccc 100644
--- a/lib/Dist/Zilla/Role/Bootstrap.pm
+++ b/lib/Dist/Zilla/Role/Bootstrap.pm
@@ -47,11 +47,25 @@ For users of plugins:
 
 with 'Dist::Zilla::Role::Plugin';
 
+sub _max_by(&@) {
+  no warnings 'redefine';
+  require List::UtilsBy;
+  *_max_by = \&List::UtilsBy::max_by;
+  goto &List::UtilsBy::max_by;
+}
+
+sub _nmax_by(&@) {
+  no warnings 'redefine';
+  require List::UtilsBy;
+  *_nmax_by = \&List::UtilsBy::nmax_by;
+  goto &List::UtilsBy::nmax_by;
+}
+
 around 'dump_config' => sub {
   my ( $orig, $self, @args ) = @_;
   my $config    = $self->$orig(@args);
   my $localconf = {};
-  for my $var (qw( try_built fallback distname )) {
+  for my $var (qw( try_built try_built_method fallback distname )) {
     my $pred = 'has_' . $var;
     if ( $self->can($pred) ) {
       next unless $self->$pred();
@@ -106,6 +120,70 @@ has fallback => (
   builder => sub { return 1 },
 );
 
+=attr C<try_built_method>
+
+=cut
+
+has try_built_method => (
+  isa     => 'Str',
+  is      => ro =>,
+  lazy    => 1,
+  builder => sub { return 'mtime' }
+);
+
+=p_method C<_pick_latest_mtime>
+
+=cut
+
+sub _pick_latest_mtime {
+  my ( $self, @candidates ) = @_;
+  return _max_by { $_->stat->mtime } @candidates;
+}
+
+=p_method C<_get_candidate_version>
+
+=cut
+
+sub _get_candidate_version {
+  my ( $self, $candidate ) = @_;
+  my $distname = $self->distname;
+  if ( $candidate->basename =~ /\A\Q$distname\E-(.+\z)/msx ) {
+    my $version = $1;
+    $version =~ s/-TRIAL\z//msx;
+    require version;
+    return version->parse($version);
+  }
+}
+
+=p_method C<_pick_latest_parseversion>
+
+=cut
+
+sub _pick_latest_parseversion {
+  my ( $self, @candidates ) = @_;
+  return _max_by { $self->_get_candidate_version($_) } @candidates;
+}
+
+my (%methods) = (
+  mtime        => _pick_latest_mtime        =>,
+  parseversion => _pick_latest_parseversion =>,
+);
+
+=p_method C<_pick_candidate>
+
+=cut
+
+sub _pick_candidate {
+  my ( $self, @candidates ) = @_;
+  my $method = $self->try_built_method;
+  if ( not exists $methods{$method} ) {
+    require Carp;
+    Carp::croak("No such candidate picking method $method");
+  }
+  $method = $methods{$method};
+  return $self->$method(@candidates);
+}
+
 =p_attr C<_bootstrap_root>
 
 =cut
@@ -119,20 +197,26 @@ has _bootstrap_root => (
       return $self->_cwd;
     }
     my $distname = $self->distname;
+
     my (@candidates) = grep { $_->basename =~ /\A\Q$distname\E-/msx } grep { $_->is_dir } $self->_cwd->children;
 
     if ( scalar @candidates == 1 ) {
       return $candidates[0];
     }
-    $self->log_debug( [ 'candidate: %s', $_->basename ] ) for @candidates;
-
-    if ( not $self->fallback ) {
-      $self->log( [ 'candidates for bootstrap (%s) != 1, and fallback disabled. not bootstrapping', 0 + @candidates ] );
-      return;
+    if ( scalar @candidates < 1 ) {
+      if ( not $self->fallback ) {
+        $self->log( [ 'candidates for bootstrap (%s) == 0, and fallback disabled. not bootstrapping', 0 + @candidates ] );
+        return;
+      }
+      else {
+        $self->log( [ 'candidates for bootstrap (%s) == 0, fallback to boostrapping <distname>/', 0 + @candidates ] );
+        return $self->_cwd;
+      }
     }
 
-    $self->log( [ 'candidates for bootstrap (%s) != 1, fallback to boostrapping <distname>/', 0 + @candidates ] );
-    return $self->_cwd;
+    $self->log_debug( [ '>1 candidates, picking one by method %s', $self->try_built_method ] );
+    return $self->_pick_candidate(@candidates);
+
   },
 );
 
diff --git a/t/02-try-built-mtime.t b/t/02-try-built-mtime.t
new file mode 100644
index 0000000..c18c8b3
--- /dev/null
+++ b/t/02-try-built-mtime.t
@@ -0,0 +1,88 @@
+
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+
+  package Example;
+  use Moose;
+  with 'Dist::Zilla::Role::Bootstrap';
+
+  sub bootstrap {
+    1;
+  }
+
+  __PACKAGE__->meta->make_immutable;
+  1;
+}
+
+pass("Role Composition Check Ok");
+ok( Example->bootstrap, 'invoke basic method on composed class' );
+
+require Dist::Zilla::Chrome::Test;
+require Dist::Zilla::MVP::Section;
+require Dist::Zilla::Dist::Builder;
+require Dist::Zilla::MVP::Assembler::Zilla;
+
+my $chrome  = Dist::Zilla::Chrome::Test->new();
+my $section = Dist::Zilla::MVP::Assembler::Zilla->new(
+  chrome        => $chrome,
+  zilla_class   => 'Dist::Zilla::Dist::Builder',
+  section_class => 'Dist::Zilla::MVP::Section',
+);
+use Path::FindDev qw( find_dev );
+use Path::Tiny qw( path );
+
+my $cwd    = path('./')->absolute;
+my $source = find_dev('./')->child('corpus')->child('fake_dist_01');
+
+my $scratch = Path::Tiny->tempdir;
+use File::Copy::Recursive qw(rcopy);
+
+rcopy "$source", "$scratch";
+
+$scratch->child("Example-0.01")->child('lib')->mkpath;
+$scratch->child("Example-0.10")->child('lib')->mkpath;
+$scratch->child("Example-0.05")->child('lib')->mkpath;
+
+chdir $scratch->stringify;
+
+$section->current_section->payload->{chrome} = $chrome;
+$section->current_section->payload->{root}   = $scratch->stringify;
+$section->current_section->payload->{name}   = 'Example';
+$section->finalize;
+
+my $instance = Example->plugin_from_config(
+  'testing',
+  {
+    try_built        => 1,
+    try_built_method => 'mtime'
+  },
+  $section
+);
+
+is_deeply(
+  $instance->dump_config,
+  {
+    'Dist::Zilla::Role::Bootstrap' => {
+      distname         => 'Example',
+      fallback         => 1,
+      try_built        => 1,
+      try_built_method => 'mtime',
+    }
+  },
+  'dump_config is expected'
+);
+
+is( $instance->distname,         'Example',                       'distname is Example' );
+is( $instance->_cwd,             $scratch,                        'cwd is project root/' );
+is( $instance->try_built,        1,                               'try_built is on' );
+is( $instance->try_built_method, 'mtime',                         'try_built_method is mtime' );
+is( $instance->fallback,         1,                               'fallback is on' );
+is( $instance->_bootstrap_root,  $scratch->child('Example-0.05'), '_bootstrap_root == _cwd' );
+ok( $instance->can('_add_inc'), '_add_inc method exists' );
+
+chdir $cwd->stringify;
+done_testing;
diff --git a/t/03-try-built-parseversion.t b/t/03-try-built-parseversion.t
new file mode 100644
index 0000000..9ed6800
--- /dev/null
+++ b/t/03-try-built-parseversion.t
@@ -0,0 +1,89 @@
+
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+
+  package Example;
+  use Moose;
+  with 'Dist::Zilla::Role::Bootstrap';
+
+  sub bootstrap {
+    1;
+  }
+
+  __PACKAGE__->meta->make_immutable;
+  1;
+}
+
+pass("Role Composition Check Ok");
+ok( Example->bootstrap, 'invoke basic method on composed class' );
+
+require Dist::Zilla::Chrome::Test;
+require Dist::Zilla::MVP::Section;
+require Dist::Zilla::Dist::Builder;
+require Dist::Zilla::MVP::Assembler::Zilla;
+
+my $chrome  = Dist::Zilla::Chrome::Test->new();
+my $section = Dist::Zilla::MVP::Assembler::Zilla->new(
+  chrome        => $chrome,
+  zilla_class   => 'Dist::Zilla::Dist::Builder',
+  section_class => 'Dist::Zilla::MVP::Section',
+);
+use Path::FindDev qw( find_dev );
+use Path::Tiny qw( path );
+
+my $cwd    = path('./')->absolute;
+my $source = find_dev('./')->child('corpus')->child('fake_dist_01');
+
+my $scratch = Path::Tiny->tempdir;
+use File::Copy::Recursive qw(rcopy);
+
+rcopy "$source", "$scratch";
+
+$scratch->child("Example-0.01")->child('lib')->mkpath;
+$scratch->child("Example-0.10")->child('lib')->mkpath;
+$scratch->child("Example-0.05")->child('lib')->mkpath;
+
+chdir $scratch->stringify;
+
+$section->current_section->payload->{chrome} = $chrome;
+$section->current_section->payload->{root}   = $scratch->stringify;
+$section->current_section->payload->{name}   = 'Example';
+$section->finalize;
+
+my $instance = Example->plugin_from_config(
+  'testing',
+  {
+    try_built        => 1,
+    try_built_method => 'parseversion'
+  },
+  $section
+);
+
+is_deeply(
+  $instance->dump_config,
+  {
+    'Dist::Zilla::Role::Bootstrap' => {
+      distname         => 'Example',
+      fallback         => 1,
+      try_built        => 1,
+      try_built_method => 'parseversion',
+    }
+  },
+  'dump_config is expected'
+);
+
+is( $instance->distname,         'Example',      'distname is Example' );
+is( $instance->_cwd,             $scratch,       'cwd is project root/' );
+is( $instance->try_built,        1,              'try_built is on' );
+is( $instance->try_built_method, 'parseversion', 'try_built_method is parseversion' );
+
+is( $instance->fallback, 1, 'fallback is on' );
+is( $instance->_bootstrap_root, $scratch->child('Example-0.10'), '_bootstrap_root == _cwd' );
+ok( $instance->can('_add_inc'), '_add_inc method exists' );
+
+chdir $cwd->stringify;
+done_testing;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libdist-zilla-role-bootstrap-perl.git



More information about the Pkg-perl-cvs-commits mailing list