our
$VERSION
=
'1.1000'
;
sub
new {
my
(
$class
,
$file
) =
@_
;
bless
{},
$class
;
}
sub
load {
my
(
$proto
,
$file
) =
@_
;
my
$self
=
ref
$proto
?
$proto
:
$proto
->new;
$self
->parse(
$file
|| Cwd::abs_path(
'cpanfile'
));
$self
;
}
sub
save {
my
(
$self
,
$path
) =
@_
;
open
my
$out
,
">"
,
$path
or
die
"$path: $!"
;
print
{
$out
}
$self
->to_string;
}
sub
parse {
my
(
$self
,
$file
) =
@_
;
my
$code
=
do
{
open
my
$fh
,
"<"
,
$file
or
die
"$file: $!"
;
join
''
, <
$fh
>;
};
my
$env
= Module::CPANfile::Environment->new(
$file
);
$env
->parse(
$code
) or
die
$@;
$self
->{_mirrors} =
$env
->mirrors;
$self
->{_prereqs} =
$env
->prereqs;
}
sub
from_prereqs {
my
(
$proto
,
$prereqs
) =
@_
;
my
$self
=
$proto
->new;
$self
->{_prereqs} = Module::CPANfile::Prereqs->from_cpan_meta(
$prereqs
);
$self
;
}
sub
mirrors {
my
$self
=
shift
;
$self
->{_mirrors} || [];
}
sub
features {
my
$self
=
shift
;
map
$self
->feature(
$_
),
$self
->{_prereqs}->identifiers;
}
sub
feature {
my
(
$self
,
$identifier
) =
@_
;
$self
->{_prereqs}->feature(
$identifier
);
}
sub
prereq {
shift
->prereqs }
sub
prereqs {
my
$self
=
shift
;
$self
->{_prereqs}->as_cpan_meta;
}
sub
merged_requirements {
my
$self
=
shift
;
$self
->{_prereqs}->merged_requirements;
}
sub
effective_prereqs {
my
(
$self
,
$features
) =
@_
;
$self
->prereqs_with(@{
$features
|| []});
}
sub
prereqs_with {
my
(
$self
,
@feature_identifiers
) =
@_
;
my
$prereqs
=
$self
->prereqs;
my
@others
=
map
{
$self
->feature(
$_
)->prereqs }
@feature_identifiers
;
$prereqs
->with_merged_prereqs(\
@others
);
}
sub
prereq_specs {
my
$self
=
shift
;
$self
->prereqs->as_string_hash;
}
sub
prereq_for_module {
my
(
$self
,
$module
) =
@_
;
$self
->{_prereqs}->find(
$module
);
}
sub
options_for_module {
my
(
$self
,
$module
) =
@_
;
my
$prereq
=
$self
->prereq_for_module(
$module
) or
return
;
$prereq
->requirement->options;
}
sub
merge_meta {
my
(
$self
,
$file
,
$version
) =
@_
;
$version
||=
$file
=~ /\.yml$/ ?
'1.4'
:
'2'
;
my
$prereq
=
$self
->prereqs;
my
$meta
= CPAN::Meta->load_file(
$file
);
my
$prereqs_hash
=
$prereq
->with_merged_prereqs(
$meta
->effective_prereqs)->as_string_hash;
my
$struct
= { %{
$meta
->as_struct},
prereqs
=>
$prereqs_hash
};
CPAN::Meta->new(
$struct
)->save(
$file
, {
version
=>
$version
});
}
sub
_dump {
my
$str
=
shift
;
chomp
(
my
$value
= Data::Dumper->new([
$str
])->Terse(1)->Dump);
$value
;
}
sub
to_string {
my
(
$self
,
$include_empty
) =
@_
;
my
$mirrors
=
$self
->mirrors;
my
$prereqs
=
$self
->prereq_specs;
my
$code
=
''
;
$code
.=
$self
->_dump_mirrors(
$mirrors
);
$code
.=
$self
->_dump_prereqs(
$prereqs
,
$include_empty
);
for
my
$feature
(
$self
->features) {
$code
.=
sprintf
"feature %s, %s => sub {\n"
, _dump(
$feature
->{identifier}), _dump(
$feature
->{description});
$code
.=
$self
->_dump_prereqs(
$feature
->{spec},
$include_empty
, 4);
$code
.=
"}\n\n"
;
}
$code
=~ s/\n+$/\n/s;
$code
;
}
sub
_dump_mirrors {
my
(
$self
,
$mirrors
) =
@_
;
my
$code
=
""
;
for
my
$url
(
@$mirrors
) {
$code
.=
"mirror '$url';\n"
;
}
$code
=~ s/\n+$/\n/s;
$code
;
}
sub
_dump_prereqs {
my
(
$self
,
$prereqs
,
$include_empty
,
$base_indent
) =
@_
;
my
$code
=
''
;
for
my
$phase
(
qw(runtime configure build test develop)
) {
my
$indent
=
$phase
eq
'runtime'
?
''
:
' '
;
$indent
= (
' '
x (
$base_indent
|| 0)) .
$indent
;
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
$requirements
;
$phase_code
.=
"};\n"
unless
$phase
eq
'runtime'
;
$code
.=
$phase_code
.
"\n"
if
$requirements
or
$include_empty
;
}
$code
=~ s/\n+$/\n/s;
$code
;
}
1;