=head2 $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new( module => MODOBJ );
-Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the
+Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the
provided C<MODOBJ>.
*** DEPRECATED ***
The optional argument C<format> is used to indicate what type of dist
-you would like to create (like C<CPANPLUS::Dist::MM> or
+you would like to create (like C<CPANPLUS::Dist::MM> or
C<CPANPLUS::Dist::Build> and so on ).
C<< CPANPLUS::Dist->new >> is exclusively meant as a method to be
inherited by C<CPANPLUS::Dist::MM|Build>.
-Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success
+Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success
and false on failure.
=cut
my $tmpl = {
module => { required => 1, allow => IS_MODOBJ, store => \$mod },
### for backwards compatibility
- format => { default => $class, store => \$format,
+ format => { default => $class, store => \$format,
allow => [ __PACKAGE__->dist_types ],
},
};
my $obj = $format->SUPER::new;
$obj->mk_accessors( qw[parent status] );
-
+
### set the parent
$obj->parent( $mod );
$obj->status($acc);
### add minimum supported accessors
- $acc->mk_accessors( qw[prepared created installed uninstalled
+ $acc->mk_accessors( qw[prepared created installed uninstalled
distdir dist] );
}
### backdoor method to add more dist types
sub _add_dist_types { my $self = shift; push @Dists, @_ };
-
+
### backdoor method to exclude dist types
sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
sub _reset_dist_ignore { @Ignore = () };
require => 1,
except => [ keys %except ]
);
- my %ignore = map { $_ => $_ } @Ignore;
-
+ my %ignore = map { $_ => $_ } @Ignore;
+
push @Dists, grep { not $ignore{$_} and not $except{$_} }
__PACKAGE__->_dist_types;
}
current process.
=cut
-
+
sub rescan_dist_types {
my $dist = shift;
$Loaded = 0; # reset the flag;
return $dist->dist_types;
- }
+ }
}
=head2 $bool = CPANPLUS::Dist->has_dist_type( $type )
sub has_dist_type {
my $dist = shift;
my $type = shift or return;
-
+
return scalar grep { $_ eq $type } CPANPLUS::Dist->dist_types;
-}
+}
=head2 $bool = $dist->prereq_satisfied( modobj => $modobj, version => $version_spec )
my $dist = shift;
my $cb = $dist->parent->parent;
my %hash = @_;
-
+
my($mod,$ver);
my $tmpl = {
version => { required => 1, store => \$ver },
modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
};
-
+
check( $tmpl, \%hash ) or return;
-
+
return 1 if $mod->is_uptodate( version => $ver );
-
+
if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
- error(loc(
+ error(loc(
"This distribution depends on %1, but the latest version".
" of %2 on CPAN (%3) doesn't satisfy the specific version".
" dependency (%4). You may have to resolve this dependency ".
- "manually.",
+ "manually.",
$mod->module, $mod->module, $mod->version, $ver ));
-
+
}
return;
=head2 $configure_requires = $dist->find_configure_requires( [file => /path/to/META.yml] )
-Reads the configure_requires for this distribution from the META.yml
+Reads the configure_requires for this distribution from the META.yml or META.json
file in the root directory and returns a hashref with module names
and versions required.
sub find_configure_requires {
my $self = shift;
my $mod = $self->parent;
+ my %hash = @_;
+
+ my ($meta);
+ my $href = {};
+
+ my $tmpl = {
+ file => { store => \$meta },
+ };
+
+ check( $tmpl, \%hash ) or return;
+
my $meth = 'configure_requires';
-
- ### the prereqs as we have them now
- my @args = (
+
+ {
+
+ ### the prereqs as we have them now
+ my @args = (
defaults => $mod->status->$meth || {},
- keys => [ $meth ],
- );
+ );
+
+ my @possibles = do { defined $mod->status->extract
+ ? ( META_JSON->( $mod->status->extract ),
+ META_YML->( $mod->status->extract ) )
+ : ()
+ };
+
+ unshift @possibles, $meta if $meta;
+
+ META: foreach my $mfile ( grep { -e } @possibles ) {
+ push @args, ( file => $mfile );
+ if ( $mfile =~ /\.json/ ) {
+ $href = $self->_prereqs_from_meta_json( @args, keys => [ 'configure' ] );
+ }
+ else {
+ $href = $self->_prereqs_from_meta_file( @args, keys => [ $meth ] );
+ }
+ last META;
+ }
- ### the default file to use, which may be overridden
- push @args, ( file => META_YML->( $mod->status->extract ) )
- if defined $mod->status->extract;
-
- my $href = $self->_prereqs_from_meta_file( @args, @_ );
+ }
### and store it in the module
$mod->status->$meth( $href );
return { %$href };
-}
+}
sub find_mymeta_requires {
my $self = shift;
my $mod = $self->parent;
+ my %hash = @_;
+
+ my ($meta);
+ my $href = {};
+
+ my $tmpl = {
+ file => { store => \$meta },
+ };
+
+ check( $tmpl, \%hash ) or return;
+
my $meth = 'prereqs';
-
- ### the prereqs as we have them now
- my @args = (
+
+ {
+
+ ### the prereqs as we have them now
+ my @args = (
defaults => $mod->status->$meth || {},
- keys => [qw|requires build_requires|],
- );
+ );
+
+ my @possibles = do { defined $mod->status->extract
+ ? ( MYMETA_JSON->( $mod->status->extract ),
+ MYMETA_YML->( $mod->status->extract ) )
+ : ()
+ };
+
+ unshift @possibles, $meta if $meta;
+
+ META: foreach my $mfile ( grep { -e } @possibles ) {
+ push @args, ( file => $mfile );
+ if ( $mfile =~ /\.json/ ) {
+ $href = $self->_prereqs_from_meta_json( @args,
+ keys => [ qw|build test runtime| ] );
+ }
+ else {
+ $href = $self->_prereqs_from_meta_file( @args,
+ keys => [ qw|build_requires requires| ] );
+ }
+ last META;
+ }
- ### the default file to use, which may be overridden
- push @args, ( file => MYMETA_YML->( $mod->status->extract ) )
- if defined $mod->status->extract;
-
- my $href = $self->_prereqs_from_meta_file( @args, @_ );
+ }
### and store it in the module
$mod->status->$meth( $href );
return { %$href };
}
-
+
sub _prereqs_from_meta_file {
my $self = shift;
- my $mod = $self->parent;
+ my $mod = $self->parent;
my %hash = @_;
my( $meta, $defaults, $keys );
- my $tmpl = { ### check if we have an extract path. if not, we
+ my $tmpl = { ### check if we have an extract path. if not, we
### get 'undef value' warnings from file::spec
file => { default => do { defined $mod->status->extract
? META_YML->( $mod->status->extract )
store => \$defaults },
keys => { required => 1, default => [], strict_type => 1,
store => \$keys },
- };
-
+ };
+
check( $tmpl, \%hash ) or return;
-
+
### if there's a meta file, we read it;
if( -e $meta ) {
### Parse::CPAN::Meta uses exceptions for errors
### hash returned in list context!!!
my ($doc) = eval { Parse::CPAN::Meta::LoadFile( $meta ) };
-
+
unless( $doc ) {
error(loc( "Could not read %1: '%2'", $meta, $@ ));
return $defaults;
} if $doc->{ $key };
}
}
-
+
+ ### and return a copy
+ return \%{ $defaults };
+}
+
+sub _prereqs_from_meta_json {
+ my $self = shift;
+ my $mod = $self->parent;
+ my %hash = @_;
+
+ my( $meta, $defaults, $keys );
+ my $tmpl = { ### check if we have an extract path. if not, we
+ ### get 'undef value' warnings from file::spec
+ file => { default => do { defined $mod->status->extract
+ ? META_JSON->( $mod->status->extract )
+ : '' },
+ store => \$meta,
+ },
+ defaults => { required => 1, default => {}, strict_type => 1,
+ store => \$defaults },
+ keys => { required => 1, default => [], strict_type => 1,
+ store => \$keys },
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ ### if there's a meta file, we read it;
+ if( -e $meta ) {
+
+ ### Parse::CPAN::Meta uses exceptions for errors
+ ### hash returned in list context!!!
+ my ($doc) = eval { Parse::CPAN::Meta->load_file( $meta ) };
+
+ unless( $doc ) {
+ error(loc( "Could not read %1: '%2'", $meta, $@ ));
+ return $defaults;
+ }
+
+ ### read the keys now, make sure not to throw
+ ### away anything that was already added
+ #for my $key ( @$keys ) {
+ # $defaults = {
+ # %$defaults,
+ # %{ $doc->{$key} },
+ # } if $doc->{ $key };
+ #}
+ my $prereqs = $doc->{prereqs} || {};
+ for my $key ( @$keys ) {
+ $defaults = {
+ %$defaults,
+ %{ $prereqs->{$key}->{requires} },
+ } if $prereqs->{ $key }->{requires};
+ }
+ }
+
### and return a copy
return \%{ $defaults };
}
PREREQ_IGNORE, TARGET_IGNORE,
PREREQ_INSTALL, TARGET_INSTALL,
}->{ $conf->get_conf('prereqs') } || '';
-
+
### XXX BIG NASTY HACK XXX FIXME at some point.
### when installing Bundle::CPANPLUS::Dependencies, we want to
### install all packages matching 'cpanplus' to be installed last,
### we got a transparent implementation.. that would mean we would
### just have to remove the 'sort' here, and all will be well
my @sorted_prereqs;
-
+
### use regex, could either be a module name, or a package name
if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
my (@first, @last);
### first, transfer this key/value pairing into a
### list of module objects + desired versions
my @install_me;
-
+
for my $mod ( @sorted_prereqs ) {
( my $version = $prereqs->{$mod} ) =~ s#[^0-9\._]+##g;
-
+
### 'perl' is a special case, there's no mod object for it
if( $mod eq PERL_CORE ) {
-
+
### run a CLI invocation to see if the perl you specified is
### uptodate
my $ok = run( command => "$^X -M$version -e1", verbose => 0 );
unless( $ok ) {
error(loc( "Module '%1' needs perl version '%2', but you ".
"only have version '%3' -- can not proceed",
- $self->module, $version,
+ $self->module, $version,
$cb->_perl_version( perl => $^X ) ) );
- return;
+ return;
}
next;
}
-
+
my $modobj = $cb->module_tree($mod);
#### XXX we ignore the version, and just assume that the latest
}
if ( $cb->_vcmp( $version, $core ) > 0 ) {
error(loc( "Version of core module '%1' ('%2') is too low for ".
- "'%3' (needs '%4') -- carrying on but this may be a problem",
- $mod, $core,
+ "'%3' (needs '%4') -- carrying on but this may be a problem",
+ $mod, $core,
$self->module, $version ));
}
next;
### see bug [#11840]
### if either force or prereq_build are given, the prereq
### should be built anyway
- next if (!$force and !$prereq_build) &&
+ next if (!$force and !$prereq_build) &&
$dist->prereq_satisfied(modobj => $modobj, version => $version);
### either we're told to ignore the prereq,
"-- weird", $modobj->module));
$modobj->add_to_includepath();
-
+
next;
}
}
https://perl5.git.perl.org / perl5.git / commitdiff