view release on metacpan or  search on metacpan

bin/rs  view on Meta::CPAN

  sub compile {
	  my $root;
	  if ($root = not $>) {
		  # drop root privilege before compile, as suggested by many packages.
		  my $u = $s->{'compile-as'} || $ENV{USER};
		  if ($u eq 'root') {
			  say c(RR, 'You are compiling as root!');
			  $root = 0;
		  } else {
			  runas($u);
		  }
	  }
	  my ($p, $o, $oid, $pkg, $d) = (abs_path(shift), getcwd());
	  chdir $s->{'compile-in'} or die $!;
	  if (-d $p) {
		  $oid = shift;
		  if ($s->{prepared}) {
			  $d = $p;
		  } else {
			  mkdir $d = $oid or die $!;
			  xsh(0, qw/git clone --shared/, '--branch=' . ($s->{branch} || $oid),
			      $p, $d);
		  }
	  } else {
		  ($oid) = $p =~ m{([^/]*).(tar.\w+|tgz)$};
		  ($d) = (xsh(1, qw/tar -xvf/, $p))[0] =~ m|([^/\n]*)| or die 'bad tarball.';
	  }
	  ($pkg) = $s->{package} || $oid =~ m|(.*)-|;
	  chdir $d or die "chdir $d: $!.";
	  my $b = do {
		  if ($s->{cpan}) {
			  if (-f 'Makefile.PL') {
				  {'no-configure' => 1,
				   'post-configure' => "perl Makefile.PL INSTALL_BASE=$s->{prefix} NO_PERLLOCAL=1 NO_PACKLIST=1",
				   'post-make' => 'make test'};
			  } elsif (-f 'Build.PL') {
				  {'pre-configure' => "perl Build.PL",
				       'no-configure' => 1,
				       'post-configure' => './Build',
				       'no-make' => 1,
				       'post-make' => './Build test',
				       'no-make-install' => 1,
				       'post-make-install' => "./Build install --install_base=$s->{prefix}"};
			  } else {
				  die c(RR, 'Neither Makefile.PL nor Build.PL found.');
			  }
		  } else {
			  my ($b, $v) = (do $s->{build}, $pkg);
			  $b = $b->($s) if ref $b eq 'CODE';
			  $v = $b->{$v} until ref $v or not $v;
			  $v;
		  }
	  };
	  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.