Permalink
Browse files

Implemented from_prereqs, to_string and save

  • Loading branch information...
1 parent 4af72cf commit 6810d1ff15cc4adde6f89ee0b7e267949185ab1c @miyagawa committed Mar 23, 2013
Showing with 145 additions and 0 deletions.
  1. +1 −0 .gitignore
  2. +105 −0 lib/Module/CPANfile.pm
  3. +39 −0 t/from_prereqs.t
View
@@ -1,4 +1,5 @@
META.yml
+MYMETA.*
Makefile
inc/
pm_to_blib
View
@@ -18,13 +18,29 @@ sub load {
$self;
}
+sub save {
+ my($self, $path) = @_;
+
+ open my $out, ">", $path or die "$path: $!";
+ print {$out} $self->to_string;
+}
+
sub parse {
my $self = shift;
my $file = Cwd::abs_path($self->{file});
$self->{result} = Module::CPANfile::Environment::parse($file) or die $@;
}
+sub from_prereqs {
+ my($proto, $prereqs) = @_;
+
+ my $self = $proto->new;
+ $self->{result} = Module::CPANfile::Result->from_prereqs($prereqs);
+
+ $self;
+}
+
sub prereqs { shift->prereq }
sub prereq {
@@ -54,6 +70,37 @@ sub merge_meta {
CPAN::Meta->new($struct)->save($file, { version => $version });
}
+sub to_string {
+ my($self, $include_empty) = @_;
+
+ my $prereqs = $self->{result}{spec};
+
+ my $code = '';
+ for my $phase (qw(runtime configure build test develop)) {
+ my $indent = $phase eq 'runtime' ? '' : ' ';
+
+ my($phase_code, $requirements);
+ $phase_code .= "on $phase => sub {\n" unless $phase eq 'runtime';
+
+ for my $type (qw(requires recommends suggests conflicts)) {
+ for my $mod (sort keys %{$prereqs->{$phase}{$type}}) {
+ my $ver = $prereqs->{$phase}{$type}{$mod};
+ $phase_code .= $ver eq '0'
+ ? "${indent}$type '$mod';\n"
+ : "${indent}$type '$mod', '$ver';\n";
+ $requirements++;
+ }
+ }
+
+ $phase_code .= "};\n" unless $phase eq 'runtime';
+
+ $code .= $phase_code . "\n" if $requirements or $include_empty;
+ }
+
+ $code =~ s/\n+$/\n/s;
+ $code;
+}
+
package Module::CPANfile::Environment;
use strict;
@@ -109,6 +156,14 @@ EVAL
package Module::CPANfile::Result;
use strict;
+sub from_prereqs {
+ my($class, $spec) = @_;
+ bless {
+ phase => 'runtime',
+ spec => $spec,
+ }, $class;
+}
+
sub new {
bless {
phase => 'runtime', # default phase
@@ -203,6 +258,25 @@ specific dependencies, not just for CPAN distributions.
Load and parse a cpanfile. By default it tries to load C<cpanfile> in
the current directory, unless you pass the path to its argument.
+=item from_prereqs
+
+ $file = Module::CPANfile->from_prereqs({
+ runtime => { requires => { DBI => '1.000' } },
+ });
+
+Creates a new Module::CPANfile object from prereqs hash you can get
+via L<CPAN::Meta>'s C<prereqs>, or L<CPAN::Meta::Prereqs>'
+C<as_string_hash>.
+
+ # read MYMETA, then feed the prereqs to create Module::CPANfile
+ my $meta = CPAN::Meta->load_file('MYMETA.json');
+ my $file = Module::CPANfile->from_prereqs($meta->prereqs);
+
+ # load cpanfile, then recreate it with round-trip
+ my $file = Module::CPANfile->load('cpanfile');
+ $file = Module::CPANfile->from_prereqs($file->prereq_specs);
+ # or $file->prereqs->as_string_hash
+
=item prereqs
Returns L<CPAN::Meta::Prereqs> object out of the parsed cpanfile.
@@ -211,6 +285,37 @@ Returns L<CPAN::Meta::Prereqs> object out of the parsed cpanfile.
Returns a hash reference that should be passed to C<< CPAN::Meta::Prereqs->new >>.
+=item to_string($include_empty)
+
+ $file->to_string;
+ $file->to_string(1);
+
+Returns a canonical string (code) representation for cpanfile. Useful
+if you want to convert L<CPAN::Meta::Prereqs> to a new cpanfile.
+
+ # read MYMETA's prereqs and print cpanfile representation of it
+ my $meta = CPAN::Meta->load_file('MYMETA.json');
+ my $file = Module::CPANfile->from_prereqs($meta->prereqs);
+ print $file->to_sring;
+
+By default, it omits the phase where there're no modules
+registered. If you pass the argument of a true value, it will print
+them as well.
+
+=item save
+
+ $file->save('cpanfile');
+
+Saves the currently loaded prereqs as a new C<cpanfile> by calling
+C<to_string>. Beware B<this method will overwrite the existing
+cpanfile without any warning or backup>. Taking a backup or giving
+warnings to users is a caller's responsibility.
+
+ # Read MYMETA.json and creates a new cpanfile
+ my $meta = CPAN::Meta->load_file('MYMETA.json');
+ my $file = Module::CPANfile->from_prereqs($meta->prereqs);
+ $file->save('cpanfile');
+
=item merge_meta
$file->merge_meta('META.yml');
View
@@ -0,0 +1,39 @@
+use strict;
+use Test::More;
+
+eval { require CPAN::Meta::Prereqs; CPAN::Meta::Prereqs->VERSION(2.120921); 1 }
+ or plan skip_all => "CPAN::Meta::Prereqs not found";
+
+use Module::CPANfile;
+use t::Utils;
+
+{
+ my $r = write_cpanfile(<<FILE);
+requires 'perl', '5.008001';
+requires 'DBI';
+requires 'Plack', '1.0001';
+test_requires 'Test::More', '0.90, != 0.91';
+FILE
+
+ my $prereqs = Module::CPANfile->load->prereqs;
+ my $file = Module::CPANfile->from_prereqs($prereqs->as_string_hash);
+
+ is_deeply $file->prereq_specs, $prereqs->as_string_hash;
+
+ is $file->to_string, <<FILE;
+requires 'DBI';
+requires 'Plack', '1.0001';
+requires 'perl', '5.008001';
+
+on test => sub {
+ requires 'Test::More', '>= 0.90, != 0.91';
+};
+FILE
+
+ $file->save('cpanfile.new');
+
+ my $content = do { local $/; open my $in, 'cpanfile.new'; <$in> };
+ is $content, $file->to_string;
+}
+
+done_testing;

0 comments on commit 6810d1f

Please sign in to comment.