Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

First cut for the cpanfile parser

  • Loading branch information...
commit c4124d1a0d38651a61b24fc3f6f9b0d51d400974 1 parent 48f868d
@miyagawa authored
View
62 lib/CPANfile.pm
@@ -0,0 +1,62 @@
+package CPANfile;
+use strict;
+use warnings;
+use Cwd;
+use CPANfile::Environment ();
+
+sub new {
+ my($class, $file) = @_;
+ my $self = bless { file => $file || "cpanfile" }, $class;
+ $self->parse;
+ $self;
+}
+
+sub parse {
+ my $self = shift;
+
+ my $file = Cwd::abs_path($self->{file});
+ $self->{result} = CPANfile::Environment::parse($file) or die $@;
+}
+
+sub prereq {
+ my $self = shift;
+ require CPAN::Meta::Prereqs;
+ CPAN::Meta::Prereqs->new($self->prereq_specs);
+}
+
+sub prereq_specs {
+ my $self = shift;
+ $self->{result}{spec};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+CPANfile - Parse cpanfile
+
+=head1 SYNOPSIS
+
+ use CPANfile;
+
+ my $file = CPANfile->new("cpanfile");
+ my $meta = $file->prereqs; # CPAN::Meta::Prereqs object
+
+=head1 DESCRIPTION
+
+CPANfile is a tool to handle L<cpanfile> format to load application
+specific dependencies, not just for CPAN distributions.
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa
+
+=head1 SEE ALSO
+
+L<cpanfile>, L<CPAN::Meta>, L<CPAN::Meta::Spec>
+
+=cut
+
+
View
107 lib/CPANfile/Environment.pm
@@ -0,0 +1,107 @@
+package CPANfile::Environment;
+use strict;
+
+my @bindings = qw(
+ on requires recommends suggests conflicts
+ osname perl
+ configure_requires build_requires test_requires author_requires
+);
+
+my $file_id = 1;
+
+sub import {
+ my($class, $result_ref) = @_;
+ my $pkg = caller;
+
+ $$result_ref = CPANfile::Environment::Result->new;
+ for my $binding (@bindings) {
+ no strict 'refs';
+ *{"$pkg\::$binding"} = sub { $$result_ref->$binding(@_) };
+ }
+}
+
+sub parse {
+ my $file = shift;
+
+ my $code = do {
+ open my $fh, "<", $file or die "$file: $!";
+ join '', <$fh>;
+ };
+
+ my $res = eval sprintf <<EVAL, $file_id++;
+package CPANfile::Environment::Sandbox%d;
+my \$_result;
+no warnings;
+use CPANfile::Environment \\\$_result;
+
+$code;
+
+\$_result;
+EVAL
+
+ if (my $err = $@ || $!) { die "Parsing $file failed: $err" };
+
+ return $res;
+}
+
+package CPANfile::Environment::Result;
+
+sub new {
+ bless {
+ phase => 'runtime', # default phase
+ spec => {},
+ }, shift;
+}
+
+sub on {
+ my($self, $phase, $code) = @_;
+ local $self->{phase} = $phase;
+ $code->()
+}
+
+sub os { die "TODO" }
+sub perl { die "TODO" }
+
+sub requires {
+ my($self, $module, $requirement) = @_;
+ $self->{spec}{$self->{phase}}{requires}{$module} = $requirement || 0;
+}
+
+sub recommends {
+ my($self, $module, $requirement) = @_;
+ $self->{spec}->{$self->{phase}}{recommends}{$module} = $requirement || 0;
+}
+
+sub suggests {
+ my($self, $module, $requirement) = @_;
+ $self->{spec}->{$self->{phase}}{suggests}{$module} = $requirement || 0;
+}
+
+sub conflicts {
+ my($self, $module, $requirement) = @_;
+ $self->{spec}->{$self->{phase}}{conflicts}{$module} = $requirement || 0;
+}
+
+# Module::Install compatible shortcuts
+
+sub configure_requires {
+ my($self, @args) = @_;
+ $self->on(configure => sub { $self->requires(@args) });
+}
+
+sub build_requires {
+ my($self, @args) = @_;
+ $self->on(build => sub { $self->requires(@args) });
+}
+
+sub test_requires {
+ my($self, @args) = @_;
+ $self->on(test => sub { $self->requires(@args) });
+}
+
+sub author_requires {
+ my($self, @args) = @_;
+ $self->on(develop => sub { $self->requires(@args) });
+}
+
+1;
View
22 t/Utils.pm
@@ -0,0 +1,22 @@
+package t::Utils;
+use base qw(Exporter);
+
+our @EXPORT = qw(write_cpanfile);
+
+sub write_cpanfile {
+ open my $fh, ">cpanfile" or die $!;
+ print $fh @_;
+
+ return Remover->new("cpanfile");
+}
+
+package
+ Remover;
+sub new {
+ bless { file => $_[1] }, $_[0];
+}
+
+sub DESTROY {
+ unlink $_[0]->{file};
+}
+
View
59 t/parse.t
@@ -0,0 +1,59 @@
+use strict;
+use CPANfile;
+use Test::More;
+use Cwd;
+use File::Basename qw(dirname);
+use t::Utils;
+
+chdir "t/samples";
+
+{
+ eval {
+ my $file = CPANfile->new;
+ };
+ like $@, qr/No such file/;
+}
+
+{
+ my $r = write_cpanfile(<<FILE);
+configure_requires 'ExtUtils::MakeMaker', 5.5;
+
+requires 'DBI';
+requires 'Plack', '0.9970';
+conflicts 'Moose', '< 0.8';
+
+on 'test' => sub {
+ requires 'Test::More';
+};
+
+on 'develop' => sub {
+ requires 'Catalyst::Runtime', '> 5.8000, < 5.9';
+ recommends 'Catalyst::Plugin::Foo';
+};
+
+test_requires 'Test::Warn', 0.1;
+author_requires 'Module::Install', 0.99;
+FILE
+
+ my $file = CPANfile->new;
+ my $prereq = $file->prereq;
+
+ is_deeply $prereq->as_string_hash, {
+ configure => {
+ requires => { 'ExtUtils::MakeMaker' => '5.5' },
+ },
+ test => {
+ requires => { 'Test::More' => 0, 'Test::Warn' => '0.1' },
+ },
+ runtime => {
+ requires => { 'Plack' => '0.9970', 'DBI' => 0 },
+ conflicts => { 'Moose' => '< 0.8' },
+ },
+ develop => {
+ requires => { 'Catalyst::Runtime' => '> 5.8000, < 5.9', 'Module::Install' => '0.99' },
+ recommends => { 'Catalyst::Plugin::Foo' => 0 },
+ }
+ };
+}
+
+done_testing;
View
0  t/samples/.gitkeep
No changes.
Please sign in to comment.
Something went wrong with that request. Please try again.