view release on metacpan or  search on metacpan

lib/CPANPLUS/Dist/Gentoo.pm  view on Meta::CPAN

 };

 my $FAIL = sub {
  $stat->created(0);
  $stat->dist(undef);
  $self->_abort(@_) if @_;
  0;
 };

 unless ($stat->prepared) {
  return $FAIL->(
   'Can\'t create', $stat->distribution, 'since it was never prepared'
  );
 }

 if ($stat->created) {
  $self->_skip($stat->distribution, 'was already created');
  $file = $stat->dist; # Keep the existing one.
  return $OK->();
 }

 my $dir = $stat->ebuild_dir;
 unless (-d $dir) {
  eval { File::Path::mkpath($dir) };
  return $FAIL->("mkpath($dir): $@") if $@;
 }

 $file = $stat->ebuild_file;

 # Create a placeholder ebuild to prevent recursion with circular dependencies.
 {
  open my $eb, '>', $file or return $FAIL->("open($file): $!");
  print $eb "PLACEHOLDER\n";
 }

 $stat->created(0);
 $stat->dist(undef);

 $self->SUPER::create(@_);

 return $FAIL->() unless $stat->created;

 {
  open my $eb, '>', $file or return $FAIL->("open($file): $!");
  my $source = $self->ebuild_source;
  return $FAIL->() unless defined $source;
  print $eb $source;
 }

 return $FAIL->() if $stat->do_manifest and not $self->update_manifest;

 return $OK->();
}

=head2 C<update_manifest>

Updates the F<Manifest> file for the ebuild associated to the current dist object.

=cut

sub update_manifest {
 my $self = shift;
 my $stat = $self->status;

 my $file = $stat->ebuild_file;
 unless (defined $file and -e $file) {
  return $self->_abort('The ebuild file is invalid or does not exist');
 }

 unless (File::Copy::copy($stat->fetched_arch => $stat->distdir)) {
  return $self->_abort("Couldn\'t copy the distribution file to distdir ($!)");
 }

 $self->_notify('Adding Manifest entry for', $stat->distribution);

 return $self->_run([ 'ebuild', $file, 'manifest' ], 0);
}

=head2 C<ebuild_source>

Returns the source of the ebuild for the current dist object, or C<undef> when one of the dependencies couldn't be mapped to an existing ebuild.

=cut

my $dep_tree_contains;
{
 my %seen;

 $dep_tree_contains = sub {
  my ($dist, $target) = @_;

  return 0 if $seen{$dist};
  local $seen{$dist} = 1;

  for my $kid (@{ $dependencies{$dist} }) {
   return 1 if $kid eq $target
            or $dep_tree_contains->($kid, $target);
  }

  return 0;
 }
}

sub ebuild_source {
 my $self = shift;
 my $stat = $self->status;

 {
  my $name = $stat->name;
  my %recursive_kids = map { $_ => 1 }
                        grep $dep_tree_contains->($_, $name),
                         @{ $dependencies{$name} };
  if (%recursive_kids) {
   my (@requires, @recursive_requires);
   for (@{ $stat->requires }) {
    if ($recursive_kids{$_->[0]}) {
     push @recursive_requires, $_;
    } else {
     push @requires, $_;
    }
   }