view release on metacpan or  search on metacpan

inc/My/Builder.pm  view on Meta::CPAN

package My::Builder;

use strict;
use warnings;
use base 'Module::Build';

use lib "inc";
use File::Spec::Functions qw(catfile rel2abs);
use ExtUtils::Command;
use LWP::Simple qw(getstore head);
use File::Find;
use File::Glob qw(bsd_glob);
use File::Path qw();
use File::ShareDir;
use File::Temp qw(tempdir tempfile);
use Digest::SHA qw(sha1_hex);
use Archive::Extract;
use Config;
use Text::Patch;
use IPC::Run3;

sub ACTION_install {
  my $self = shift;
  my $sharedir = eval {File::ShareDir::dist_dir('Alien-IUP')} || '';

  if ( -d $sharedir ) {
    print STDERR "Removing the old '$sharedir'\n";
    File::Path::rmtree($sharedir);
    File::Path::mkpath($sharedir);
  }

  return $self->SUPER::ACTION_install(@_);
}

sub ACTION_code {
  my $self = shift;

  if ( ! -e 'build_done' ) {
    my $inst = $self->notes('already_installed_lib');
    if (defined $inst) {
      $self->config_data('config', { LIBS   => $inst->{lflags},
                                     INC    => $inst->{cflags},
                                   });
    }
    else {
      # some questions before we start
      my $dbg = !$ENV{TRAVIS} ? $self->prompt("\nDo you want to see debug info + all messages during 'make' (y/n)?", 'n') : 'n';
      $self->notes('build_msgs',       lc($dbg) eq 'y' ? 1 : 0);
      $self->notes('build_debug_info', lc($dbg) eq 'y' ? 1 : 0);
      #my $large_imglib = $ENV{TRAVIS} ? 'y' : lc($self->prompt("Do you wanna compile built-in images with large (48x48) size? ", "y"));
      my $large_imglib = 'y'; #forcing large icons
      $self->notes('build_large_imglib', lc($large_imglib) eq 'y' ? 1 : 0);

      # important directories
      my $download = 'download';
      my $patches = 'patches';
      my $build_src = 'build_src';
      # we are deriving the subdir name from VERSION as we want to prevent
      # troubles when user reinstalls the newer version of Alien package
      my $share_subdir = $self->{properties}->{dist_version};
      if ($self->notes('is_devel_cvs_version')) {
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
        $share_subdir .= sprintf("_CVS_%02d%02d%02d_%02d%02d",$year+1900-2000,$mon+1,$mday,$hour,$min);
      }
      my $build_out = catfile('sharedir', $share_subdir);
      $self->add_to_cleanup($build_out);

      # store info into CofigData
      $self->config_data('iup_url', $self->notes('iup_url'));
      $self->config_data('im_url', $self->notes('im_url'));
      $self->config_data('cd_url', $self->notes('cd_url'));

      # prepare sources
      my $unpack;
      $unpack = (-d "$build_src/iup") && !$ENV{TRAVIS} ? $self->prompt("\nDir '$build_src/iup' exists, wanna replace with clean sources?", "n") : 'y';
      if (lc($unpack) eq 'y') {
        File::Path::rmtree("$build_src/iup") if -d "$build_src/iup";
        $self->prepare_sources($self->notes('iup_url'), $self->notes('iup_sha1'), $download, $build_src);
        if ($self->notes('iup_patches')) {
          $self->apply_patch("$build_src/iup", $_)  foreach (@{$self->notes('iup_patches')});
        }
      }

      $unpack = (-d "$build_src/im") && !$ENV{TRAVIS} ? $self->prompt("\nDir '$build_src/im'  exists, wanna replace with clean sources?", "n") : 'y';
      if (lc($unpack) eq 'y') {
        File::Path::rmtree("$build_src/im") if -d "$build_src/im";
        $self->prepare_sources($self->notes('im_url'), $self->notes('im_sha1'), $download, $build_src);
        if ($self->notes('im_patches')) {
          $self->apply_patch("$build_src/im", $_)  foreach (@{$self->notes('im_patches')});
        }
      }

      $unpack = (-d "$build_src/cd") && !$ENV{TRAVIS} ? $self->prompt("\nDir '$build_src/cd'  exists, wanna replace with clean sources?", "n") : 'y';
      if (lc($unpack) eq 'y') {
        File::Path::rmtree("$build_src/cd") if -d "$build_src/cd";
        $self->prepare_sources($self->notes('cd_url'), $self->notes('cd_sha1'), $download, $build_src);
        if ($self->notes('cd_patches')) {
          $self->apply_patch("$build_src/cd", $_)  foreach (@{$self->notes('cd_patches')});
        }
      }

      $unpack = (-d "$build_src/zlib") && !$ENV{TRAVIS} ? $self->prompt("\nDir '$build_src/zlib'  exists, wanna replace with clean sources?", "n") : 'y';
      if ($self->notes('zlib_url') && !$self->config_data('syszlib_lflags') && lc($unpack) eq 'y') {
        File::Path::rmtree("$build_src/zlib") if -d "$build_src/zlib";
        $self->prepare_sources($self->notes('zlib_url'), $self->notes('zlib_sha1'), $download, $build_src);
        if ($self->notes('zlib_patches')) {
          $self->apply_patch("$build_src/zlib", $_)  foreach (@{$self->notes('zlib_patches')});
        }
      }

      $unpack = (-d "$build_src/freetype") && !$ENV{TRAVIS} ? $self->prompt("\nDir '$build_src/freetype'  exists, wanna replace with clean sources?", "n") : 'y';
      if ($self->notes('freetype_url') && !$self->config_data('sysfreetype_lflags') && lc($unpack) eq 'y') {
        File::Path::rmtree("$build_src/freetype") if -d "$build_src/freetype";
        $self->prepare_sources($self->notes('freetype_url'), $self->notes('freetype_sha1'), $download, $build_src);
        if ($self->notes('freetype_patches')) {
          $self->apply_patch("$build_src/freetype", $_)  foreach (@{$self->notes('freetype_patches')});
        }
      }

      $unpack = (-d "$build_src/ftgl") && !$ENV{TRAVIS} ? $self->prompt("\nDir '$build_src/ftgl'  exists, wanna replace with clean sources?", "n") : 'y';
      if ($self->notes('ftgl_url') && lc($unpack) eq 'y') {
        File::Path::rmtree("$build_src/ftgl") if -d "$build_src/ftgl";
        $self->prepare_sources($self->notes('ftgl_url'), $self->notes('ftgl_sha1'), $download, $build_src);
        if ($self->notes('ftgl_patches')) {
          $self->apply_patch("$build_src/ftgl", $_)  foreach (@{$self->notes('ftgl_patches')});
        }
      }

      ### XXX hack for handling github tarballs
      unless (-d "$build_src/cd" && -d "$build_src/im" && -d "$build_src/iup") {
        for my $f (bsd_glob("$build_src/*")) {
          if ($f =~ m!^\Q$build_src\E/.*?(im|cd|iup).*$!) {
            print "renaming: $f $build_src/$1\n";
            rename ($f, "$build_src/$1");
          }
        }
      }

      # go for build
      my $success = $self->build_binaries($build_out, $build_src);
      my $done    = $self->config_data('info_done');
      my $iuplibs = $self->config_data('iup_libs');
      if ($self->notes('build_debug_info')) {
        print STDERR "Build result: $done->{$_} - $_\n" foreach (sort keys %$done);
        print STDERR "Output libs : $iuplibs->{$_} - $_\n" foreach (sort keys %$iuplibs);
      }
      die "###BUILD FAILED### essential libs (iup/im/cd) not built!" unless $done->{"iup:iup"} && $done->{"iup:iupim"} && $done->{"iup:iupcd"};
      die "###BUILD FAILED###" unless $success;
      #DEBUG: die intentionally at this point if you want to see build details from cpan testers
      print STDERR "RESULT: OK!\n";

      # store info about build to ConfigData
      $self->config_data('share_subdir', $share_subdir);
      $self->config_data('config', { PREFIX => '@PrEfIx@',
                                     LIBS   => '-L' . $self->quote_literal('@PrEfIx@/lib') .
                                               ' -l' . join(' -l', @{$self->config_data('linker_libs')}) .
                                               ' ' . $self->config_data('extra_lflags'),
                                     INC    => '-I' . $self->quote_literal('@PrEfIx@/include') .
                                               ' ' . $self->config_data('extra_cflags'),
                                   });
    }
    # mark sucessfully finished build
    $self->touchfile('build_done');
  }
  $self->SUPER::ACTION_code;
}

sub prepare_sources {
  my ($self, $url, $sha1, $download, $build_src) = @_;
  my $archive = $self->fetch_file( url=>$url, sha1=>$sha1, localdir=>$download );
  #XXX hack
  if ($archive !~ /\.(tar.gz|tgz|tar|zip|tbz|tar.bz2)$/) {
    rename($archive, "$archive.$$.tgz");
    $archive = "$archive.$$.tgz";
  }
  my $ae = Archive::Extract->new( archive => $archive );
  die "###ERROR### Cannot extract tarball ", $ae->error unless $ae->extract(to => $build_src);
}

sub fetch_file {
  my ($self, %args) = @_;

  my $url = $args{url};
  my $sha1 = $args{sha1};
  my $localdir = $args{localdir};
  my $localfile = $args{localfile};
  die "###ERROR### fetch_file: undefined url\n" unless $url;

  # create $localdir if necessary
  File::Path::mkpath($localdir) unless $localdir && -d $localdir;

  # handle redirects
  my $head = head($url);
  $url = $head->request->uri if defined $head;

  # download destination
  unless ($localfile) {
   $localfile = $url;
   $localfile =~ s/^.*?([^\\\/]+)$/$1/; #skip all but file part of URL
   $localfile =~ s/\?.*$//; #skip URL params
  }
  $localfile = File::Spec->catfile($localdir, $localfile) if $localdir;

inc/My/Builder.pm  view on Meta::CPAN

  my $rv = run3("$Config{cc} -c -o $obj $src $cflags", \undef, \undef, \undef, { return_if_system_error => 1 } );
  return ($rv == 1 && $? == 0) ? 1 : 0;
}

# check presence of lib(s) specified as params
sub check_lib {
  my ($self, $l, $cflags, $lflags) = @_;
  $cflags ||= '';
  $lflags ||= '';
  $cflags =~ s/[\r\n]//g;
  $lflags =~ s/[\r\n]//g;
  my @libs = ref($l) ? @$l : ( $l );
  my $liblist = scalar(@libs) ? '-l' . join(' -l', @libs) : '';

  my ($fs, $src) = tempfile('tmpfileXXXXXX', SUFFIX => '.c', UNLINK => 1);
  my ($fo, $obj) = tempfile('tmpfileXXXXXX', SUFFIX => '.o', UNLINK => 1);
  my ($fe, $exe) = tempfile('tmpfileXXXXXX', SUFFIX => '.out', UNLINK => 1);
  syswrite($fs, <<MARKER); # write test source code
int main() { return 0; }

MARKER
  close($fs);
  $src = $self->quote_literal($src);
  $obj = $self->quote_literal($obj);
  $exe = $self->quote_literal($exe);
  my $output;
  #Note: $Config{cc} might contain e.g. 'ccache cc' (FreeBSD 8.0)
  my $rv1 = run3("$Config{cc} -c -o $obj $src $cflags", \undef, \$output, \$output, { return_if_system_error => 1 } );
  unless ($rv1 == 1 && $? == 0) {
    #print STDERR "OUTPUT(compile):\n$output\n" if $output;
    return 0
  }
  my $rv2 = run3("$Config{ld} $obj -o $exe $lflags $liblist", \undef, \$output, \$output, { return_if_system_error => 1 } );
  unless ($rv2 == 1 && $? == 0) {
    #print STDERR "OUTPUT(link):\n$output\n" if $output;
    return 0
  }
  return 1;
}

# pure perl implementation of patch functionality
sub apply_patch {
  my ($self, $dir_to_be_patched, $patch_file) = @_;
  my ($src, $diff);

  undef local $/;
  open(DAT, $patch_file) or die "###ERROR### Cannot open file: '$patch_file'\n";
  $diff = <DAT>;
  close(DAT);
  $diff =~ s/\r\n/\n/g; #normalise newlines
  $diff =~ s/\ndiff /\nSpLiTmArKeRdiff /g;
  my @patches = split('SpLiTmArKeR', $diff);

  print STDERR "Applying patch file: '$patch_file'\n";
  foreach my $p (@patches) {
    my ($k) = map{$_ =~ /\n---\s*([\S]+)/} $p;
    # doing the same like -p1 for 'patch'
    $k =~ s|\\|/|g;
    $k =~ s|^[^/]*/(.*)$|$1|;
    $k = catfile($dir_to_be_patched, $k);
    print STDERR "- gonna patch '$k'\n" if $self->notes('build_debug_info');

    if (open(SRC, $k)) {
      $src  = <SRC>;
      close(SRC);
      $src =~ s/\r\n/\n/g; #normalise newlines
    }
    else {
      $src = '';
    }

    my $out = eval { Text::Patch::patch( $src, $p, { STYLE => "Unified" } ) };
    if ($out) {
      open(OUT, ">", $k) or die "###ERROR### Cannot open file for writing: '$k'\n";
      print(OUT $out);
      close(OUT);
    }
    else {
      warn "###WARN### Patching '$k' failed: $@";
    }
  }
}

sub run_output_tail {
  my ($self, $limit, @cmd) = @_;
  my $output;
  print STDERR "CMD: " . join(' ',@cmd) . "\n";
  print STDERR "- running (stdout+stderr redirected)...\n";
  my $rv = run3(\@cmd, \undef, \$output, \$output, { return_if_system_error => 1 } );
  my $success = ($rv == 1 && $? == 0) ? 1 : 0;
  $output = substr $output, -$limit if defined $limit; # we want just last N chars
  if (!defined($limit)) {
    print STDERR "OUTPUT:\n", $output, "\n";
  }
  elsif ($limit>0) {
    print STDERR "OUTPUT: (only last $limit chars)\n", $output, "\n";
  }
  return $success;
}

sub run_output_on_error {
  my ($self, $limit, @cmd) = @_;
  my $output;
  print STDERR "CMD: " . join(' ',@cmd) . "\n";
  print STDERR "- running (stdout+stderr redirected)...\n";
  my $rv = run3(\@cmd, \undef, \$output, \$output, { return_if_system_error => 1 } );
  my $success = ($rv == 1 && $? == 0) ? 1 : 0;
  if ($success) {
    print STDERR "- finished successfully (output suppressed)\n";
  }
  else {
    $output = substr $output, -$limit if defined $limit; # we want just last N chars
    if (!defined($limit)) {
      print STDERR "OUTPUT:\n", $output, "\n";
    }
    elsif ($limit>0) {
      print STDERR "OUTPUT: (only last $limit chars)\n", $output, "\n";
    }
  }
  return $success;
}