[Bps-public-commit] Shipwright branch, cpanable_backends, updated. 9bdf71d0ffaa9306000c736cacea2b6946c33bc6
Ruslan Zakirov
ruz at bestpractical.com
Mon Sep 14 18:15:30 EDT 2009
The branch, cpanable_backends has been updated
via 9bdf71d0ffaa9306000c736cacea2b6946c33bc6 (commit)
via e231a6991bbaf21f47ab763b4f42e50c01949643 (commit)
via 7b6129c665d1b32f90e0c5eae57b659392285a78 (commit)
via 2a1ec7003b5d769e20c81f3787a29c8edaf9e096 (commit)
via 4b576742e0b5a906bb2c3245dd5a8b27acdf14d5 (commit)
via 30c8e55741482360d650cb5c60ffe9bbad9b894e (commit)
from dd715ddd51b8ba4eeac22ddaca0acb41b72e38b0 (commit)
Summary of changes:
lib/Shipwright/Backend.pm | 45 ++++++-------
lib/Shipwright/Backend/Base.pm | 17 ++++-
lib/Shipwright/Backend/FS.pm | 19 +++++-
lib/Shipwright/Backend/Git.pm | 11 +++-
lib/Shipwright/Backend/SVK.pm | 10 +++-
lib/Shipwright/Backend/SVN.pm | 11 +++-
lib/Shipwright/Source/Base.pm | 4 +
lib/Shipwright/Util.pm | 136 ++++++++++++++++++++++++++--------------
8 files changed, 172 insertions(+), 81 deletions(-)
- Log -----------------------------------------------------------------
commit 30c8e55741482360d650cb5c60ffe9bbad9b894e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 15 01:22:38 2009 +0400
log when we guess dependencies
diff --git a/lib/Shipwright/Source/Base.pm b/lib/Shipwright/Source/Base.pm
index 93538fd..4208c5f 100644
--- a/lib/Shipwright/Source/Base.pm
+++ b/lib/Shipwright/Source/Base.pm
@@ -101,6 +101,7 @@ sub _follow {
chdir catdir($path);
if ( $path =~ /\bcpan-Bundle-(.*)/ ) {
+ $self->log->info("is a CPAN Bundle");
my $file = $1;
$file =~ s!-!/!;
@@ -145,6 +146,8 @@ sub _follow {
}
elsif ( -e 'Build.PL' ) {
+ $self->log->info("is a Module::Build based dist");
+
Shipwright::Util->run(
[
$^X, '-Mversion',
@@ -170,6 +173,7 @@ sub _follow {
or confess "can't read Makefile.PL: $!";
if ( $makefile =~ /inc::Module::Install/ ) {
+ $self->log->info("is a Module::Install based dist");
# PREREQ_PM in Makefile is not good enough for inc::Module::Install, which
# will omit features(..). we'll put deps in features(...) into recommends part
commit 4b576742e0b5a906bb2c3245dd5a8b27acdf14d5
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 15 01:43:31 2009 +0400
shuffle utils, update pod
diff --git a/lib/Shipwright/Util.pm b/lib/Shipwright/Util.pm
index 0f24e10..53b3b74 100644
--- a/lib/Shipwright/Util.pm
+++ b/lib/Shipwright/Util.pm
@@ -19,12 +19,18 @@ BEGIN {
*DumpFile = *YAML::Tiny::DumpFile;
}
-=head2 Load, LoadFile, Dump, DumpFile
-to make pod-coverage.t happy.
-Load, LoadFile, Dump and DumpFile are just dropped in from YAML or YAML::Syck
-=cut
+=head1 LIST
+
+=head2 YAML
+
+=head3 Load, LoadFile, Dump, DumpFile
+
+Load, LoadFile, Dump and DumpFile are just dropped in from L<YAML> or L<YAML::Syck>.
+
+
+=head2 GENERAL HELPERS
-=head2 run
+=head3 run
a wrapper of run3 sub in IPC::Run3.
@@ -73,7 +79,48 @@ EOF
}
-=head2 shipwright_root
+=head3 select
+
+wrapper for the select in core
+
+=cut
+
+my ( $null_fh, $stdout_fh, $cpan_fh, $cpan_log_path, $cpan_fh_flag );
+
+# use $cpan_fh_flag to record if we've selected cpan_fh before, so so,
+# we don't need to warn that any more.
+
+open $null_fh, '>', '/dev/null';
+
+$cpan_log_path = catfile( tmpdir(), 'shipwright_cpan.log');
+
+open $cpan_fh, '>>', $cpan_log_path;
+$stdout_fh = CORE::select();
+
+sub select {
+ my $self = shift;
+ my $type = shift;
+
+ if ( $type eq 'null' ) {
+ CORE::select $null_fh;
+ }
+ elsif ( $type eq 'stdout' ) {
+ CORE::select $stdout_fh;
+ }
+ elsif ( $type eq 'cpan' ) {
+ warn "CPAN related output will be at $cpan_log_path\n"
+ unless $cpan_fh_flag;
+ $cpan_fh_flag = 1;
+ CORE::select $cpan_fh;
+ }
+ else {
+ confess "unknown type: $type";
+ }
+}
+
+=head2 PATHS
+
+=head3 shipwright_root
Returns the root directory that Shipwright has been installed into.
Uses %INC to figure out where Shipwright.pm is.
@@ -91,7 +138,7 @@ sub shipwright_root {
return ($SHIPWRIGHT_ROOT);
}
-=head2 share_root
+=head3 share_root
Returns the 'share' directory of the installed Shipwright module. This is
currently only used to store the initial files in project.
@@ -123,46 +170,7 @@ sub share_root {
}
-=head2 select
-
-wrapper for the select in core
-
-=cut
-
-my ( $null_fh, $stdout_fh, $cpan_fh, $cpan_log_path, $cpan_fh_flag );
-
-# use $cpan_fh_flag to record if we've selected cpan_fh before, so so,
-# we don't need to warn that any more.
-
-open $null_fh, '>', '/dev/null';
-
-$cpan_log_path = catfile( tmpdir(), 'shipwright_cpan.log');
-
-open $cpan_fh, '>>', $cpan_log_path;
-$stdout_fh = CORE::select();
-
-sub select {
- my $self = shift;
- my $type = shift;
-
- if ( $type eq 'null' ) {
- CORE::select $null_fh;
- }
- elsif ( $type eq 'stdout' ) {
- CORE::select $stdout_fh;
- }
- elsif ( $type eq 'cpan' ) {
- warn "CPAN related output will be at $cpan_log_path\n"
- unless $cpan_fh_flag;
- $cpan_fh_flag = 1;
- CORE::select $cpan_fh;
- }
- else {
- confess "unknown type: $type";
- }
-}
-
-=head2 user_home
+=head3 user_home
return current user's home directory
@@ -180,7 +188,7 @@ sub user_home {
}
}
-=head2 shipwright_user_root
+=head3 shipwright_user_root
the user's own shipwright root where we put internal files in.
it's ~/.shipwright by default.
commit 2a1ec7003b5d769e20c81f3787a29c8edaf9e096
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 15 01:44:13 2009 +0400
add find_module util
diff --git a/lib/Shipwright/Util.pm b/lib/Shipwright/Util.pm
index 53b3b74..e3cb53b 100644
--- a/lib/Shipwright/Util.pm
+++ b/lib/Shipwright/Util.pm
@@ -118,6 +118,38 @@ sub select {
}
}
+=head3 find_module
+
+Takes perl modules name space and name of a module in the space.
+Finds and returns matching module name using case insensetive search, for
+example:
+
+ Shipwright::Util->find_module('Shipwright::Backend', 'svn');
+ # returns 'Shipwright::Backend::SVN'
+
+ Shipwright::Util->find_module('Shipwright::Backend', 'git');
+ # returns 'Shipwright::Backend::Git'
+
+Returns undef if there is no module matching criteria.
+
+=cut
+
+sub find_module {
+ my $self = shift;
+ my $space = shift;
+ my $name = shift;
+
+ my @space = split /::/, $space;
+ my @globs = map File::Spec->catfile($_, @space, '*.pm'), @INC;
+ foreach my $glob ( @globs ) {
+ foreach my $module ( map /([^\\\/]+)\.pm$/ glob $glob ) {
+ return join '::', @space, $module
+ if lc $name eq lc $module;
+ }
+ }
+ return undef;
+}
+
=head2 PATHS
=head3 shipwright_root
commit 7b6129c665d1b32f90e0c5eae57b659392285a78
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 15 01:45:29 2009 +0400
add build in Backend::Base
we usually use _init for that, but I don't think these
days it should be private. initialize is already ocupied
so it required a new name. build is good candidate
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index 821eace..9cf8c48 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -35,10 +35,13 @@ the constructor
=cut
sub new {
- my $class = shift;
- my $self = {@_};
+ my $proto = shift;
+ my $self = bless {@_}, ref $proto || $proto;
+ return $self->build;
+}
- bless $self, $class;
+sub build {
+ my $self = shift;
$self->log( Log::Log4perl->get_logger( ref $self ) );
return $self;
}
commit e231a6991bbaf21f47ab763b4f42e50c01949643
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 15 01:47:17 2009 +0400
add strip_repository method in Backend::Base
simple function that unconditionally strips leading xxx[+yyy]:
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index 9cf8c48..f2f8afe 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -912,6 +912,14 @@ sub local_dir {
return $target;
}
+sub strip_reposiotry {
+ my $self = shift;
+ my $repo = $self->repository;
+ $repo =~ s/^[a-z+]+://;
+ $self->repository($repo);
+ return;
+}
+
=back
=cut
commit 9bdf71d0ffaa9306000c736cacea2b6946c33bc6
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 15 02:00:47 2009 +0400
possibility in Backend.pm to load external implementations
allow people to build implementations out of shipwright
distribution without changing Backend.pm
diff --git a/lib/Shipwright/Backend.pm b/lib/Shipwright/Backend.pm
index 1135a5e..fda75eb 100644
--- a/lib/Shipwright/Backend.pm
+++ b/lib/Shipwright/Backend.pm
@@ -4,42 +4,37 @@ use warnings;
use strict;
use Carp;
use UNIVERSAL::require;
-use File::Spec::Functions qw/rel2abs/;
use Shipwright::Util;
sub new {
my $class = shift;
my %args = @_;
- my $module;
-
croak 'need repository arg' unless exists $args{repository};
- if ( $args{repository} =~ m{^\s*(svk:|//)} ) {
- $args{repository} =~ s{^\s*svk:}{};
- $module = 'Shipwright::Backend::SVK';
- }
- elsif ( $args{repository} =~ m{^\s*svn[:+]} ) {
- $args{repository} =~ s{^\s*svn:(?!//)}{};
- $module = 'Shipwright::Backend::SVN';
- }
- elsif ( $args{repository} =~ m{^\s*fs:} ) {
- $args{repository} =~ s{^\s*fs:}{};
- $args{repository} =~ s/^~/Shipwright::Util->user_home/e;
- my $abs_path = rel2abs($args{repository});
- $args{repository} = $abs_path if $abs_path;
- $module = 'Shipwright::Backend::FS';
- }
- elsif ( $args{repository} =~ m{^\s*git:} ) {
- $args{repository} =~ s{^\s*git:}{};
- $module = 'Shipwright::Backend::Git';
+ $args{repository} =~ s/^\s+//;
+ $args{repository} =~ s/\s+$//;
+
+ # exception for svk repos, they can start with //
+ if ( $args{repository} =~ m{^//} ) {
+ $args{repository} = 'svk:'. $args{repository};
}
- else {
- croak "invalid repository: $args{repository}\n";
+
+ my ($backend, $subtype);
+ if ( $args{repository} =~ /^([a-z]+)(?:\+([a-z]+))?:/ ) {
+ ($backend, $subtype) = ($1, $2);
+ } else {
+ croak "invalid repository, doesn't start from xxx: or xxx+yyy:";
}
- $module->require;
+ my $module = Shipwright::Util->find_module(__PACKAGE__, $backend);
+ unless ( $module ) {
+ croak "Couldn't find backend implementing '$backend'";
+ }
+ $module->require
+ or croak "Couldn't load module '$module'"
+ ." implementing backend '$backend': $@";
return $module->new(%args);
}
@@ -62,7 +57,7 @@ Shipwright::Backend - Backend
=head1 DESCRIPTION
See <Shipwright::Manual::Glossary/repository> to understand concept. Look
-at list of </SUPPORTED BACKENDS> and L<IMPLEMENTING BACKENDS> if you want
+at list of </SUPPORTED BACKENDS> or L<IMPLEMENTING BACKENDS> if you want
add a new one.
=head1 SUPPORTED BACKENDS
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index f2f8afe..01f56a5 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -912,7 +912,7 @@ sub local_dir {
return $target;
}
-sub strip_reposiotry {
+sub strip_repository {
my $self = shift;
my $repo = $self->repository;
$repo =~ s/^[a-z+]+://;
diff --git a/lib/Shipwright/Backend/FS.pm b/lib/Shipwright/Backend/FS.pm
index d2ec094..5c28149 100644
--- a/lib/Shipwright/Backend/FS.pm
+++ b/lib/Shipwright/Backend/FS.pm
@@ -3,7 +3,7 @@ package Shipwright::Backend::FS;
use warnings;
use strict;
use Carp;
-use File::Spec::Functions qw/catfile splitdir catdir/;
+use File::Spec::Functions qw/catfile splitdir catdir rel2abs/;
use Shipwright::Util;
use File::Copy::Recursive qw/rcopy rmove/;
use File::Path qw/remove_tree make_path/;
@@ -27,7 +27,22 @@ for Shipwright L<repository|Shipwright::Manual::Glossary/repository>.
=head1 METHODS
-=over
+=cut
+
+sub build {
+ my $self = shift;
+ $self->strip_repository;
+
+ my $repo = $self->repository;
+ $repo =~ s/^~/Shipwright::Util->user_home/e;
+ my $abs_path = rel2abs($repo);
+ $repo = $abs_path if $abs_path;
+ $self->repository($repo);
+
+ $self->SUPER::build(@_);
+}
+
+=over 4
=item initialize
diff --git a/lib/Shipwright/Backend/Git.pm b/lib/Shipwright/Backend/Git.pm
index 825adb1..d4ae409 100644
--- a/lib/Shipwright/Backend/Git.pm
+++ b/lib/Shipwright/Backend/Git.pm
@@ -38,7 +38,16 @@ for Shipwright L<repository|Shipwright::Manual::Glossary/repository>.
=head1 METHODS
-=over
+=cut
+
+sub build {
+ my $self = shift;
+ $self->strip_repository
+ if $self->repository =~ m{^git:[a-z]+(?:\+[a-z]+)?://};
+ $self->SUPER::build(@_);
+}
+
+=over 4
=item initialize
diff --git a/lib/Shipwright/Backend/SVK.pm b/lib/Shipwright/Backend/SVK.pm
index 49aebb1..f7fa809 100644
--- a/lib/Shipwright/Backend/SVK.pm
+++ b/lib/Shipwright/Backend/SVK.pm
@@ -37,7 +37,15 @@ L<Shipwright::Manual::ENV/SHIPWRIGHT_SVN> can be used as well.
=head1 METHODS
-=over
+=cut
+
+sub build {
+ my $self = shift;
+ $self->strip_repository;
+ $self->SUPER::build(@_);
+}
+
+=over 4
=item initialize
diff --git a/lib/Shipwright/Backend/SVN.pm b/lib/Shipwright/Backend/SVN.pm
index c6a2c34..aa13c68 100644
--- a/lib/Shipwright/Backend/SVN.pm
+++ b/lib/Shipwright/Backend/SVN.pm
@@ -36,7 +36,16 @@ F<svnadmin> command is expected to be in the same directory as F<svn>.
=head1 METHODS
-=over
+=cut
+
+sub build {
+ my $self = shift;
+ $self->strip_repository
+ if $self->repository =~ m{^svn:[a-z]+(?:\+[a-z]+)?://};
+ $self->SUPER::build(@_);
+}
+
+=over 4
=item initialize
diff --git a/lib/Shipwright/Util.pm b/lib/Shipwright/Util.pm
index e3cb53b..c1b530e 100644
--- a/lib/Shipwright/Util.pm
+++ b/lib/Shipwright/Util.pm
@@ -142,7 +142,7 @@ sub find_module {
my @space = split /::/, $space;
my @globs = map File::Spec->catfile($_, @space, '*.pm'), @INC;
foreach my $glob ( @globs ) {
- foreach my $module ( map /([^\\\/]+)\.pm$/ glob $glob ) {
+ foreach my $module ( map { /([^\\\/]+)\.pm$/; $1 } glob $glob ) {
return join '::', @space, $module
if lc $name eq lc $module;
}
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list