Permalink
Browse files

refactor parser to preserve original prereq line as an object

  • Loading branch information...
1 parent c755b41 commit 2f3af986c6bde04c6fc5a7d1d117474c3c1d8e0f @miyagawa committed Sep 19, 2013
View
17 lib/Module/CPANfile.pm
@@ -5,7 +5,6 @@ use Cwd;
use Carp ();
use Module::CPANfile::Environment;
use Module::CPANfile::Features;
-use Module::CPANfile::Prereqs;
use Module::CPANfile::Requirement;
our $VERSION = '1.0002';
@@ -41,34 +40,33 @@ sub parse {
my $env = Module::CPANfile::Environment->new($file);
$env->parse($code) or die $@;
- $self->{_features} = Module::CPANfile::Features->new($env->features);
- $self->{_prereqs} = Module::CPANfile::Prereqs->new($env->prereqs);
+ $self->{_prereqs} = $env->prereqs;
}
sub from_prereqs {
my($proto, $prereqs) = @_;
my $self = $proto->new;
- $self->{_prereqs} = Module::CPANfile::Prereqs->new($prereqs);
+ $self->{_prereqs} = Module::CPANfile::Prereqs->from_cpan_meta($prereqs);
$self;
}
sub features {
my $self = shift;
- $self->{_features} ? $self->{_features}->all : ();
+ map $self->feature($_), $self->{_prereqs}->identifiers;
}
sub feature {
my($self, $identifier) = @_;
- $self->{_features}->get($identifier);
+ $self->{_prereqs}->feature($identifier);
}
sub prereq { shift->prereqs }
sub prereqs {
my $self = shift;
- $self->{_prereqs};
+ $self->{_prereqs}->as_cpan_meta;
}
sub effective_prereqs {
@@ -90,6 +88,11 @@ sub prereq_specs {
$self->prereqs->as_string_hash;
}
+sub options_for_module {
+ my $self = shift;
+
+}
+
sub merge_meta {
my($self, $file, $version) = @_;
View
47 lib/Module/CPANfile/Environment.pm
@@ -2,6 +2,7 @@ package Module::CPANfile::Environment;
use strict;
use warnings;
use Module::CPANfile::Result;
+use Module::CPANfile::Prereqs;
use Carp ();
my @bindings = qw(
@@ -18,9 +19,9 @@ sub new {
bless {
file => $file,
phase => 'runtime', # default phase
- features => {},
feature => undef,
- prereqs => {},
+ features => {},
+ prereqs => Module::CPANfile::Prereqs->new,
}, $class;
}
@@ -62,8 +63,7 @@ sub _evaluate {
eval $_[1];
}
-sub features { $_[0]->{features} }
-sub prereqs { $_[0]->{prereqs} }
+sub prereqs { $_[0]->{prereqs} }
# DSL goes from here
@@ -86,15 +86,16 @@ sub feature {
Carp::croak("Usage: feature 'identifier', 'Description' => sub { ... }");
}
- local $self->{feature} = $self->{features}{$identifier}
- = { identifier => $identifier, description => $description, prereqs => {} };
+ local $self->{feature} = $identifier;
+ $self->prereqs->add_feature($identifier, $description);
+
$code->();
}
sub osname { die "TODO" }
sub requirement_for {
- my ($self, $module, @args) = @_;
+ my($self, $module, @args) = @_;
my $requirement = 0;
$requirement = shift @args if @args % 2;
@@ -107,27 +108,35 @@ sub requirement_for {
}
sub requires {
- my($self, $module, @args) = @_;
- ($self->{feature} ? $self->{feature}{prereqs} : $self->{prereqs})
- ->{$self->{phase}}{requires}{$module} = $self->requirement_for($module, @args);
+ my $self = shift;
+ $self->add_prereq(requires => @_);
}
sub recommends {
- my($self, $module, @args) = @_;
- ($self->{feature} ? $self->{feature}{prereqs} : $self->{prereqs})
- ->{$self->{phase}}{recommends}{$module} = $self->requirement_for($module, @args);
+ my $self = shift;
+ $self->add_prereq(recommends => @_);
}
sub suggests {
- my($self, $module, @args) = @_;
- ($self->{feature} ? $self->{feature}{prereqs} : $self->{prereqs})
- ->{$self->{phase}}{suggests}{$module} = $self->requirement_for($module, @args);
+ my $self = shift;
+ $self->add_prereq(suggests => @_);
}
sub conflicts {
- my($self, $module, @args) = @_;
- ($self->{feature} ? $self->{feature}{prereqs} : $self->{prereqs})
- ->{$self->{phase}}{conflicts}{$module} = $self->requirement_for($module, @args);
+ my $self = shift;
+ $self->add_prereq(conflicts => @_);
+}
+
+sub add_prereq {
+ my($self, $type, $module, @args) = @_;
+
+ $self->prereqs->add_prereq(
+ feature => $self->{feature},
+ phase => $self->{phase},
+ type => $type,
+ module => $module,
+ requirement => $self->requirement_for($module, @args),
+ );
}
# Module::Install compatible shortcuts
View
15 lib/Module/CPANfile/Feature.pm
@@ -1,15 +0,0 @@
-package Module::CPANfile::Feature;
-use strict;
-use parent qw(CPAN::Meta::Feature);
-
-sub new {
- my($class, $identifier, $spec) = @_;
-
- bless {
- identifier => $identifier,
- description => $spec->{description},
- prereqs => Module::CPANfile::Prereqs->new($spec->{prereqs}),
- }, $class;
-}
-
-1;
View
4 lib/Module/CPANfile/Features.pm
@@ -1,7 +1,7 @@
package Module::CPANfile::Features;
use strict;
use Carp ();
-use Module::CPANfile::Feature;
+use CPAN::Meta::Feature;
sub new {
my($class, $features) = @_;
@@ -24,7 +24,7 @@ sub get {
my $data = $self->{features}{$identifier}
or Carp::croak("Unknown feature '$identifier'");
- Module::CPANfile::Feature->new($data->{identifier}, {
+ CPAN::Meta::Feature->new($data->{identifier}, {
description => $data->{description},
prereqs => $data->{prereqs},
});
View
21 lib/Module/CPANfile/Prereq.pm
@@ -0,0 +1,21 @@
+package Module::CPANfile::Prereq;
+use strict;
+
+sub new {
+ my($class, %options) = @_;
+ bless \%options, $class;
+}
+
+sub feature { $_[0]->{feature} }
+sub phase { $_[0]->{phase} }
+sub type { $_[0]->{type} }
+sub module { $_[0]->{module} }
+sub requirement { $_[0]->{requirement} }
+
+sub match_feature {
+ my($self, $identifier) = @_;
+ no warnings 'uninitialized';
+ $self->feature eq $identifier;
+}
+
+1;
View
101 lib/Module/CPANfile/Prereqs.pm
@@ -1,6 +1,103 @@
package Module::CPANfile::Prereqs;
use strict;
-use parent qw(CPAN::Meta::Prereqs);
+use Carp ();
+use CPAN::Meta::Feature;
+use Module::CPANfile::Prereq;
-1;
+sub from_cpan_meta {
+ my($class, $prereqs) = @_;
+
+ my $self = $class->new;
+
+ for my $phase (keys %$prereqs) {
+ for my $type (keys %{ $prereqs->{$phase} }) {
+ while (my($module, $requirement) = each %{ $prereqs->{$phase}{$type} }) {
+ $self->add_prereq(
+ phase => $phase,
+ type => $type,
+ module => $module,
+ requirement => Module::CPANfile::Requirement->new(name => $module, version => $requirement),
+ );
+ }
+ }
+ }
+
+ $self;
+}
+
+sub new {
+ my $class = shift;
+ bless {
+ prereqs => [],
+ features => {},
+ }, $class;
+}
+
+sub add_feature {
+ my($self, $identifier, $description) = @_;
+ $self->{features}{$identifier} = { description => $description };
+}
+
+sub add_prereq {
+ my($self, %args) = @_;
+ $self->add( Module::CPANfile::Prereq->new(%args) );
+}
+
+sub add {
+ my($self, $prereq) = @_;
+ push @{$self->{prereqs}}, $prereq;
+}
+
+sub as_cpan_meta {
+ my $self = shift;
+ $self->{cpanmeta} ||= $self->build_cpan_meta;
+}
+
+sub build_cpan_meta {
+ my($self, $identifier) = @_;
+
+ my $prereq_spec = {};
+ $self->prereq_each($identifier, sub {
+ my $prereq = shift;
+ $prereq_spec->{$prereq->phase}{$prereq->type}{$prereq->module} = $prereq->requirement->version;
+ });
+ CPAN::Meta::Prereqs->new($prereq_spec);
+}
+
+sub prereq_each {
+ my($self, $identifier, $code) = @_;
+
+ for my $prereq (@{$self->{prereqs}}) {
+ next unless $prereq->match_feature($identifier);
+ $code->($prereq);
+ }
+}
+
+sub identifiers {
+ my $self = shift;
+
+ my(@identifiers, %seen);
+ for my $prereq (@{$self->{prereqs}}) {
+ push @identifiers, $prereq->feature
+ if $prereq->feature && !$seen{$prereq->feature}++;
+ }
+
+ @identifiers;
+}
+
+sub feature {
+ my($self, $identifier) = @_;
+
+ my $data = $self->{features}{$identifier}
+ or Carp::croak("Unknown feature '$identifier'");
+
+ my $prereqs = $self->build_cpan_meta($identifier);
+
+ CPAN::Meta::Feature->new($identifier, {
+ description => $data->{description},
+ prereqs => $prereqs->as_string_hash,
+ });
+}
+
+1;

0 comments on commit 2f3af98

Please sign in to comment.