view release on metacpan or  search on metacpan

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

    print STDERR "Fetching '$url' ...\n";
    my $fullpath = $ff->fetch(to => $download);
    if ($fullpath && -e $fullpath && $self->check_sha1sum($fullpath, $sha1sum)) {
      print STDERR "Download OK (filesize=".(-s $fullpath).")\n";
      return $fullpath;
    }
    warn "###WARNING### Unable to fetch '$url'\n";
  }
  return;
}

sub check_sha1sum {
  my ($self, $file, $sha1sum) = @_;
  my $sha1 = Digest::SHA->new;
  my $fh;
  open($fh, $file) or die "###ERROR## Cannot check checksum for '$file'\n";
  binmode($fh);
  $sha1->addfile($fh);
  close($fh);
  my $rv = ($sha1->hexdigest eq $sha1sum) ? 1 : 0;
  warn "###WARN## sha1 mismatch: got      '", $sha1->hexdigest , "'\n",
       "###WARN## sha1 mismatch: expected '", $sha1sum, "'\n",
       "###WARN## sha1 mismatch: filesize '", (-s $file), "'\n", unless $rv;
  return $rv;
}

sub clean_dir {
  my( $self, $dir ) = @_;
  if (-d $dir) {
    File::Path::rmtree($dir);
    File::Path::mkpath($dir);
  }
}

sub quote_literal {
  # this can be be overriden in My::Builder::<platform>
  my ($self, $path) = @_;
  return $path;
}

# 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');

    open(SRC, $k) or die "###ERROR### Cannot open file: '$k'\n";
    $src  = <SRC>;
    close(SRC);
    $src =~ s/\r\n/\n/g; #normalise newlines

    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 build_binaries {
	my $self = shift;
    print STDERR "Running make ...\n";
    {
        local $CWD = rel2abs( $self->notes('src_dir') );
        #search PATH for c++ compiler
        my $cxx = $self->search_env_path(qw/c++ g++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC/);
        my @cmd = ($self->_get_make);
        push @cmd, "CXX=$cxx" if $cxx;
        printf("(cmd: %s)\n", join(' ', @cmd));
        $self->do_system(@cmd) or die "###ERROR### [$?] during make ... ";
    }
    return 1;
}

sub _get_make {
  my ($self) = @_;

  return $Config{make} if $^O =~ /^(cygwin|MSWin32)$/;

  my @try = ('make', $Config{gmake}, 'gmake', 'make', $Config{make});
  my %tested;
  print "Gonna detect default system make:\n";
  foreach my $name ( @try ) {
    next unless $name;
    next if $tested{$name};
    $tested{$name} = 1;
    print "- testing: '$name'\n";
    if ($self->_is_make($name)) {
      print "- found: '$name'\n";
      return $name
    }
  }
}

sub _is_make {
  my ($self, $name) = @_;
  my $devnull = File::Spec->devnull();
  my $ver = `$name --version 2> $devnull`;
  if ($ver =~ /make/i) {
    return 1;
  }