[Bps-public-commit] Shipwright branch, master, updated. 9bdf71d0ffaa9306000c736cacea2b6946c33bc6
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Mon Sep 14 19:50:55 EDT 2009
The branch, master 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