view release on metacpan or  search on metacpan

lib/App/grindperl.pm  view on Meta::CPAN

use v5.10.0;
use strict;
use warnings;

package App::grindperl;
our $VERSION = '0.004';

use autodie;
use Getopt::Lucid ':all';
use Path::Class;
use File::Spec;
use Carp qw/carp croak/;
use File::Copy qw/copy/;
use File::HomeDir 0.98;
use namespace::autoclean;

sub new {
  my $class = shift;

  my $self = bless {}, $class;

  if ( -r $self->config_file ) {
    unshift @ARGV, $self->read_config_file;
  }

  my $opt = Getopt::Lucid->getopt([
    Param("jobs|j")->default(9),
    Param("testjobs|t")->default(9),
    Param("output|o"),
    Param("install_root")->default(File::Spec->tmpdir),
    Param("prefix"),
    Switch("debugging")->default(1),
    Switch("threads")->default(1),
    Switch("32"),
    Switch("porting|p"),
    Switch("install"),
    Switch("config"),
    Switch("cache"),
    Switch("man"),
    Switch("edit"),
    Switch("verbose|v"),
    Keypair("additions|A"),
    Keypair("define|D"),
    List("undefine|U"),
  ]);

  $self->{opt} = $opt;
  $self->{is_git} = -d '.git';

  return $self;
}

sub opt { return $_[0]->{opt} }

sub is_git { return $_[0]->{is_git} }

sub logfile { return $_[0]->opt->get_output };

sub vlog {
  my ($self, @msg) = @_;
  return unless $self->opt->get_verbose;
  say for map { (my $s = $_) =~ s/\n$//; $s } @msg;
}

sub prefix {
  my $self = shift;
  my $prefix = $self->opt->get_prefix;
  return $prefix if defined $prefix && length $prefix;

  my $root = $self->opt->get_install_root;

  if ( $self->is_git ) {
    my $branch = qx/git symbolic-ref HEAD/;
    if ( $? ) {
      # HEAD not a symbolic ref?
      $branch = "fromgit";
    }
    else {
      chomp $branch;
      $branch =~ s{refs/heads/}{};
      $branch =~ s{/}{-}g;
    }
    my $describe = qx/git describe/;
    if ( $? ) {
      # can't describe?
      $describe = 'unknown-commit';
    }
    chomp $describe;
    return dir($root)->subdir("$branch-$describe");
  }
  else {
    my $perldir = dir()->absolute->basename;
    return dir($root)->subdir("$perldir-" . time());
  }
}

sub configure_args {
  my ($self) = @_;
  my %defines = $self->opt->get_define;
  my @undefines = $self->opt->get_undefine;
  my %additions = $self->opt->get_additions;
  my @args = qw/-des -Dusedevel -Uversiononly/;
  push @args, "-Dusethreads" if $self->opt->get_threads;
  push @args, "-DDEBUGGING" if $self->opt->get_debugging;
  push @args, "-Accflags=-m32", "-Alddlflags=-m32", "-Aldflags=-m32",
    "-Uuse64bitint", "-Uuse64bitall", "-Uusemorebits"
    if $self->opt->get_32;
  push @args, "-r" if $self->opt->get_cache;
  if ( ! $self->opt->get_man ) {
    push @args, qw/-Dman1dir=none -Dman3dir=none/;
  }
  push @args, map { "-D$_=$defines{$_}" } keys %defines;
  push @args, map { "-U$_" } @undefines;
  push @args, map { "-A$_=$additions{$_}" } keys %additions;
  push @args, "-Dprefix=" . $self->prefix;
  return @args;
}

sub cache_dir {
  my ($self) = @_;
  return dir(File::HomeDir->my_dist_data('App-grindperl', {create=>1}))->stringify;
}

sub cache_file {
  my ($self,$file) = @_;
  croak "No filename given to cache_file()"
    unless defined $file && length $file;
  return file( $self->cache_dir, $file )->stringify;
}

sub config_file {
  my ($self) = @_;
  my $config_dir = dir(File::HomeDir->my_dist_config('App-grindperl', {create=>1}));
  return $config_dir->file("grindperl.conf");
}

sub read_config_file {
  my ($self) = @_;
  open my $fh, "<", $self->config_file;
  my @args;
  while ( my $line = <$fh> ) {
    chomp $line;
    push @args, split " ", $line, 2;
  }
  return @args;
}

sub do_cmd {
  my ($self, $cmd, @args) = @_;

  my $cmdline = join( q{ }, $cmd, @args);
  if ( $self->logfile ) {
    $cmdline .= " >" . $self->logfile . " 2>&1";
  }
  $self->vlog("Running '$cmdline'");
  system($cmdline);
  return $? == 0;
}

sub verify_dir {
  my ($self) = @_;
  my $prefix = dir($self->prefix);
  return -w $prefix->parent;