view release on metacpan or  search on metacpan

bin/rs  view on Meta::CPAN

	  };
	  xsh({'feed-stdin' => 1}, $b->{'pre-configure'}, 'bash') or die 'pre-configure failed.' if $b->{'pre-configure'};
	  unless ($b->{'no-configure'}) {
		  local %ENV = %ENV;
		  xsh(0, qw/autoreconf -iv/) or die 'autoreconf failed.' unless -e 'configure';
		  my @p;
		  if ($s->{bootstrap}) {
			  $ENV{CPPFLAGS} = "-I$s->{prefix}/include" unless $b->{'no-cppflags'};
			  $ENV{LDFLAGS} = "-L$s->{prefix}/lib -Wl,-I" . linker($s);
		  }
		  push @p, "--prefix=$s->{prefix}";
		  my $e = $b->{environment};
		  $ENV{$_} = $e->{$_} for keys %$e;
		  xsh(0, './configure', @{$b->{switch}}, @p,
		      {to => *STDERR,
		       from => *STDOUT,
		       mode => '>'}, qw/| less --quit-on-intr --RAW-CONTROL-CHARS/) or die 'configure failed.';
	  }
	  xsh({'feed-stdin' => 1}, $b->{'post-configure'}, 'bash') or die 'post-configure failed.' if $b->{'post-configure'};
	  xsh(0, 'make', $s->{jobs} ? "--jobs=$s->{jobs}" : (), @{$b->{'make-parameter'}}) or die 'make failed.' unless $b->{'no-make'};
	  xsh({'feed-stdin' => 1}, $b->{'post-make'}, 'bash') or die 'post-make failed.' if $b->{'post-make'};
	  # since the following is installation process we need to switch back to root.
	  runas('root') if $root;
	  xsh(0, qw/make install/, @{$b->{'make-install-parameter'}}) or die 'make install failed.' unless $b->{'no-make-install'};
	  xsh({'feed-stdin' => 1}, $b->{'post-make-install'}, 'bash') or die 'post-make failed.' if $b->{'post-make-install'};
	  # do some cleaning.
	  unless ($s->{prepared} or $s->{'no-rm'}) {
		  my $cwd = getcwd();
		  xsh(0, qw/rm -rf/, "../$d") if $s->{rm} or confirm "'rm -rf ../$d' on $cwd";
	  }
	  # return to where we started.
	  chdir $o or die "chdir $o: $!.";
	  # the next steps.
	  diff($oid);
	  tag($oid) unless $s->{cpan};
  }
  sub _which {
	  my $r = shift;
	  if ($r =~ m{^/}) {
		  die c(RR, "Absolute path $r not prefixed by $s->{root}"), ".\n" unless 0 == index $r, $s->{root};
		  $r = substr $r, length $s->{root};
	  }
	  my ($d, @p) = (0, split m{/}, $r);
	  {subr => sub {
		  my $o = shift;
		  if ($o->{event} eq 'ent') {
			  my $u = $d >= @p || $o->{ent} eq $p[$d];
			  $d += 1 if $u and $o->{db}{c};
			  $u;
		  } elsif ($o->{event} eq 'ret') {
			  $d -= 1, 0;
		  }
	   }, prophet => 1};
  }
  for my $f (qw/tag crowded list which/) {
	  no strict 'refs';
	  *$f = sub {
		  my $pid;
		  local $SIG{PIPE} = 'IGNORE';
		  { pipe my $r, my $w or die $!;
		    $pid = xsh({asynchronous => 1},
			       qw/less -R/, {to => *STDIN,
					     from => $r,
					     mode => '<'});
		    close $r;
		    print $w jw(filter({sink => $w,
					f => &{$::{"_$f"}}}, {db => $db,
							      d => ''})) }
		  # we must wait here or we will lose control-terminal.
		  waitpid $pid, 0;
	  };
  }
  { my $refdb;
    sub _RR () { $refdb = -f $s->{refdb} ? jr(rf($s->{refdb})) : {} }
    sub _RW () {
	    print c(YY, "Writing reference counting database $s->{refdb}", ': ');
	    wf($s->{refdb}, jw($refdb));
	    say c(GG, 'done'), '.';
    }
    sub _install {
	    my $o = shift;
	    print "Satisfying: ", jw($o);
	    my $q = $refdb->{$o->{module}} ||= {};
	    my ($A, $L) = ($q->{current},
			   $s->{latest});
	    if ($A)	{ return if not $L and vcmp($A->{version}, $o->{version}) >= 0 }
	    # no update on CORE module even when latest is required.
	    else	{ return if vsat(@$o{qw/module version/}) }
	    my ($t, $B, $j, $V) = first {
		    vcmp($_->{version}, $o->{version}) >= 0
	    } @{$q->{available} ||= []};
	    if (not $L and $t) {
		    $B = $t;
		    print "Available: ", jw($B);
	    } else {
		    say 'Getting module info from metacpan...';
		    $j = Rmodinfo($o->{module});
		    if (eval { $j->{code} == 404 }) {
			    $j = Vmodinfo($o->{module});
			    my @r = map { $_->{_source} } @{$j->{hits}{hits}};
			    if (@r < 1)		{ die c(RR, "Nothing provides $o->{module}.") }
			    elsif (@r > 1)	{ say c(YY, "Multiple modules provides $o->{module}: ",
							join ', ', map { $_->{distribution} } @r) }
			    my $k = $r[0];
			    say c(YY, "Using $k->{name} for $o->{module}.");
			    my $v = $k->{version};
			    $j = {name => Nrev($o->{module}) . "-$v",
				  version => $v,
				  dependency => [{module => Nrev($k->{distribution}),
						  version => $v,
						  slice($o, qw/phase relationship/)}]};
			    $V = 1;
		    }
		    say "Latest version: $j->{version}.";
		    return if $A and $A->{version} eq $j->{version};
		    $q->{dependency}{$j->{version}} = [grep { depF($_) } @{$j->{dependency}}];
		    $B = {slice($j, qw/name version/)};
	    }
	    my $D = $q->{dependency}{$B->{version}};
	    _install($_) for @$D;
	    if ($A) {