grindperl

#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;

my $app = GrindPerl->new;
$app->run;

{
  package GrindPerl;
  use autodie;
  use Getopt::Lucid ':all';
  use Path::Class;
  use Carp qw/carp croak/;
  use File::Copy qw/copy/;
  use namespace::autoclean;

  sub new {
    my $class = shift;
    my $opt = Getopt::Lucid->getopt([
      Param("jobs|j")->default(9),
      Param("testjobs|t")->default(9),
      Param("output|o"),
      Switch("debugging")->default(1),
      Switch("config"),
      Switch("cache|c"),
      Switch("git|g")->default(1),
      Switch("verbose|v"),
      Switch("threads")->default(1),
      Keypair("define|D"),
      Keypair("undefine|U"),
    ]);
    return bless { opt => $opt }, $class;
  }

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

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

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

  sub default_args {
    return qw(
      -des -Dcc='ccache gcc' -Dusedevel
      -Dprefix=/opt/perl/fromgit -Dcf_by=dagolden
      -Dcf_email='[email protected]' -Dperladmin='[email protected]'
    );
  }
  
  sub configure_args {
    my ($self) = @_;
    my %defines = $self->opt->get_define;
    my %undefines = $self->opt->get_undefine;
    my @args = $self->default_args;
    push @args, "-Dusethreads" if $self->opt->get_threads; 
    push @args, "-DDEBUGGING" if $self->opt->get_debugging; 
    push @args, "-r" if $self->opt->get_cache;
    push @args, map { "-D$_=$defines{$_}" } keys %defines;
    push @args, map { "-U$_=$undefines{$_}" } keys %undefines;
    return @args;
  }

  sub cache_dir {
    my ($self) = @_;
    my $app = file($0)->basename;
    return dir( $ENV{HOME}, ".$app", "cache" )->stringify;
  }

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

  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 configure {
    my ($self) = @_;
    croak("Executable Configure program not found") unless -x "Configure";

    # used cached files
    for my $f ( qw/config.sh Policy.sh/ ) {
      next unless -f $self->cache_file($f);
      if ( $self->opt->get_cache ) {
        copy( $self->cache_file($f), $f );        
        if ( -f $f ) {
          $self->vlog("Copied $f from cache");
        }
        else {
          $self->vlog("Faild to copy $f from cache");
        }
      }
      else {
        unlink $self->cache_file($f);
      }
    }

    $self->do_cmd( "./Configure", $self->configure_args )
      or croak("Configure failed!");

    # save files back into cache if updated 
    dir( $self->cache_dir )->mkpath; 
    for my $f ( qw/config.sh Policy.sh/ ) {
      copy( $f, $self->cache_file($f) ) 
        if (! -f $self->cache_file($f)) || (-M $f > -M $self->cache_file($f));        
    }

    return 1;
  }

  sub run {
    my ($self) = @_;
    
    croak "Doesn't look like a perl repo" unless -f "perl.c";
    croak "Doesn't look like a perl repo" if $self->opt->get_git && ! -d ".git";

    $self->do_cmd("git clean -dxf") if $self->opt->get_git;

    $self->configure;

    exit 0 if $self->opt->get_config; # config only

    my $test_jobs = $self->opt->get_testjobs;
    my $jobs = $self->opt->get_jobs;
    if ( $test_jobs ) { 
      $ENV{TEST_JOBS} = $test_jobs if $test_jobs > 1;
      $self->vlog("Running 'make test_harness' with $test_jobs jobs");
      $self->do_cmd("make -j $jobs test_harness")
        or croak ("make test_harness failed");
    }
    else {
      $self->vlog("Running 'make test_prep' with $test_jobs jobs");
      $self->do_cmd("make -j $jobs test_prep")
        or croak("make test_prep failed!");
    }
    return 1;
  }
}