Permalink
Browse files

started DistInfo role, for housing simple information about the dist,…

… like name version etc
  • Loading branch information...
jberger committed Nov 16, 2012
1 parent 99c2e82 commit 7b86b60cbaac5d3034d8fd81d7074e117948df61
Showing with 166 additions and 120 deletions.
  1. +1 −33 lib/Moodule/Build/Base.pm
  2. +0 −53 lib/Moodule/Build/Base_TODO.pm
  3. +69 −0 lib/Moodule/Build/Role/DistInfo.pm
  4. +0 −34 t/attributes.t
  5. +96 −0 t/dist_info.t
View
@@ -6,42 +6,10 @@ use Carp;
use Moodule::Build::HashStore qw/HashStore/;
with 'Moodule::Build::Role::Logger';
+with 'Moodule::Build::Role::DistInfo';
with 'Moodule::Build::Role::Prompter';
with 'Moodule::Build::Role::ExternalCommandHelper';
with 'Moodule::Build::Role::CBuilder'; # can this be optional?
-has 'dist_name' => (
- is => 'ro',
- writer => '_set_dist_name',
- trigger => 1,
-);
-
-sub _trigger_dist_name {
- my ($self, $name) = @_;
- $name =~ s/-/::/g;
- unless (defined $self->module_name) {
- $self->_set_module_name($name);
- }
-}
-
-has 'module_name' => (
- is => 'ro',
- writer => '_set_module_name',
- trigger => 1,
-);
-
-sub _trigger_module_name {
- my ($self, $name) = @_;
- $name =~ s/::/-/g;
- unless (defined $self->dist_name) {
- $self->_set_dist_name($name);
- }
-}
-
-sub BUILD {
- my $self = shift;
- die "Need either module_name or dist_name\n" unless defined $self->dist_name;
-}
-
1;
@@ -524,16 +524,13 @@ __PACKAGE__->add_property($_) for qw(
destdir
dist_abstract
dist_author
- dist_name
dist_suffix
dist_version
- dist_version_from
has_config_data
install_base
libdoc_dirs
magic_number
mb_version
- module_name
needs_compiler
orig_dir
pm_files
@@ -630,46 +627,6 @@ EOF
return $opts{class};
}
-sub _guess_module_name {
- my $self = shift;
- my $p = $self->{properties};
- return if $p->{module_name};
- if ( $p->{dist_version_from} && -e $p->{dist_version_from} ) {
- my $mi = Module::Build::ModuleInfo->new_from_file($self->dist_version_from);
- $p->{module_name} = $mi->name;
- }
- else {
- my $mod_path = my $mod_name = $p->{dist_name};
- $mod_name =~ s{-}{::}g;
- $mod_path =~ s{-}{/}g;
- $mod_path .= ".pm";
- if ( -e $mod_path || -e "lib/$mod_path" ) {
- $p->{module_name} = $mod_name;
- }
- else {
- $self->log_warn( << 'END_WARN' );
-No 'module_name' was provided and it could not be inferred
-from other properties. This will prevent a packlist from
-being written for this file. Please set either 'module_name'
-or 'dist_version_from' in Build.PL.
-END_WARN
- }
- }
-}
-
-sub dist_name {
- my $self = shift;
- my $p = $self->{properties};
- return $p->{dist_name} if defined $p->{dist_name};
-
- die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter"
- unless $self->module_name;
-
- ($p->{dist_name} = $self->module_name) =~ s/::/-/g;
-
- return $p->{dist_name};
-}
-
sub release_status {
my ($self) = @_;
my $p = $self->{properties};
@@ -705,16 +662,6 @@ sub dist_suffix {
return $p->{dist_suffix};
}
-sub dist_version_from {
- my ($self) = @_;
- my $p = $self->{properties};
- if ($self->module_name) {
- $p->{dist_version_from} ||=
- join( '/', 'lib', split(/::/, $self->module_name) ) . '.pm';
- }
- return $p->{dist_version_from} || undef;
-}
-
sub dist_version {
my ($self) = @_;
my $p = $self->{properties};
@@ -0,0 +1,69 @@
+package Moodule::Build::Role::DistInfo;
+
+use Moo::Role;
+
+use Module::Build::ModuleInfo;
+
+requires 'log_warn';
+
+has 'dist_name' => (
+ is => 'lazy',
+ predicate => '_has_dist_name',
+);
+
+sub _build_dist_name {
+ my $self = shift;
+
+ die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter"
+ unless $self->_has_module_name;
+
+ (my $dist_name = $self->module_name) =~ s/::/-/g;
+
+ return $dist_name;
+}
+
+has 'module_name' => (
+ is => 'lazy',
+ predicate => '_has_module_name',
+);
+
+sub _build_module_name {
+ my $self = shift;
+
+ if ( $self->_has_dist_version_from && -e $self->dist_version_from ) {
+ my $mi = Module::Build::ModuleInfo->new_from_file($self->dist_version_from);
+ return $mi->name;
+ }
+ elsif ($self->_has_dist_name) {
+ my $mod_path = my $mod_name = $self->dist_name;
+ $mod_name =~ s{-}{::}g;
+ $mod_path =~ s{-}{/}g;
+ $mod_path .= ".pm";
+ if ( -e $mod_path || -e "lib/$mod_path" ) {
+ return $mod_name;
+ }
+ }
+
+ $self->log_warn( <<'END_WARN' );
+No 'module_name' was provided and it could not be inferred
+from other properties. This will prevent a packlist from
+being written for this file. Please set either 'module_name'
+or 'dist_version_from' in Build.PL.
+END_WARN
+}
+
+has 'dist_version_from' => (
+ is => 'lazy',
+ predicate => '_has_dist_version_from',
+);
+
+sub _build_dist_version_from {
+ my $self = shift;
+ if ($self->_has_module_name) {
+ return join( '/', 'lib', split(/::/, $self->module_name) ) . '.pm';
+ }
+ return undef;
+}
+
+1;
+
View
@@ -1,34 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-use Moodule::Build;
-
-subtest 'Constructor with dist_name' => sub {
- my $builder = Moodule::Build->new( dist_name => 'My-Dist' );
- isa_ok $builder, 'Moodule::Build';
- is $builder->module_name, 'My::Dist', 'module_name from dist_name';
-};
-
-subtest 'Constructor with module_name' => sub {
- my $builder = Moodule::Build->new( module_name => 'My::Dist' );
- isa_ok $builder, 'Moodule::Build';
- is $builder->dist_name, 'My-Dist', 'dist_name from module_name';
-};
-
-subtest 'Constructor with both names' => sub {
- my $builder = Moodule::Build->new( module_name => 'A', dist_name => 'B' );
- isa_ok $builder, 'Moodule::Build';
- is $builder->module_name, 'A', 'set both names (module)';
- is $builder->dist_name, 'B', 'set both names (dist)';
-};
-
-subtest 'Constructor without either name' => sub {
- my $builder = eval { Moodule::Build->new };
- my $message = $builder ? 'Did not fail' : $@;
- is $message, "Need either module_name or dist_name\n", 'throw error on no build_name or dist_name';
-};
-
-done_testing();
-
View
@@ -0,0 +1,96 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use File::Temp ();
+use Cwd qw/getcwd/;
+
+my $log = '';
+open my $log_handle, '>', \$log;
+{
+ package MyTestClass;
+ use Moo;
+ with 'Moodule::Build::Role::DistInfo';
+ sub log_warn { shift; print $log_handle @_ }
+}
+
+my $old = getcwd;
+
+subtest 'get module_name from dist_name' => sub {
+ my $dir = File::Temp->newdir;
+ chdir $dir or die "Cannot chdir to $dir\n";
+
+ make_file( qw/lib Not So Simple.pm/, 'Testing' );
+
+ my $mb = MyTestClass->new(
+ dist_name => 'Not-So-Simple',
+ dist_version => 1,
+ );
+
+ is( $mb->module_name, "Not::So::Simple",
+ "module_name guessed from dist_name"
+ );
+
+ chdir $old;
+};
+
+subtest 'cannot determine module_name' => sub {
+ my $mb = MyTestClass->new( dist_name => 'Foo-Bar' );
+ $mb->module_name;
+ ok $log, 'warn on undetermined module_name';
+};
+
+subtest 'get module_name from dist_version_from' => sub {
+ my $dir = File::Temp->newdir;
+ chdir $dir or die "Cannot chdir to $dir\n";
+
+ make_file( qw/lib Simple Name.pm/, <<'END_PACKAGE' );
+package Simple::Name;
+our $VERSION = 1.23;
+1;
+END_PACKAGE
+
+ my $mb = MyTestClass->new(
+ dist_name => 'Random-Name',
+ dist_version_from => 'lib/Simple/Name.pm',
+ );
+
+ is( $mb->module_name, "Simple::Name",
+ "module_name guessed from dist_version_from"
+ );
+
+ chdir $old;
+};
+
+subtest 'get dist_name from module_name' => sub {
+ my $mb = MyTestClass->new( module_name => 'My::Dist' );
+ is $mb->dist_name, 'My-Dist', 'dist_name from module_name';
+};
+
+subtest 'Constructor without either name' => sub {
+ my $builder = MyTestClass->new;
+ my $message = eval{ $builder->dist_name } ? 'Did not fail' : $@;
+ like $message, qr/Can't determine distribution name/, 'dies without either dist_name or module_name';
+};
+
+done_testing;
+
+sub make_file {
+ my $content = pop;
+ my $filename = pop;
+
+ my $old = getcwd;
+
+ for my $dir (@_) {
+ mkdir $dir or die "Cannot create new dir $dir\n";
+ chdir $dir or die "Cannot chdir into $dir\n";
+ }
+
+ open my $fh, '>', $filename;
+ print $fh "$content";
+
+ chdir $old;
+
+}
+

0 comments on commit 7b86b60

Please sign in to comment.