view release on metacpan or  search on metacpan

lib/Perl/Dist/Strawberry/Step/InstallPerlCore.pm  view on Meta::CPAN

    if ($self->global->{test_core}) {
      $new_env->{PERL_SKIP_TTY_TEST} = 1;
      $self->boss->message( 1, "Testing perl $version ...\n" );
      $log = catfile($self->global->{debug_dir}, 'perl_make_test.log.txt');
      $self->execute_special([$maketool, @make_args, 'test'], $log, $log, $new_env);
      $self->boss->message( 1, "$maketool test FAILED!") unless(defined $rv && $rv == 0);
    }

    # Installing perl.
    $self->boss->message( 1, "Installing perl $version ...\n" );
    $log = catfile($self->global->{debug_dir}, 'perl_make_install.log.txt');
    $rv = $self->execute_special([$maketool, @make_args, 'install', 'UNINST=1'], $log, $log, $new_env);
    die "FATAL: $maketool install FAILED!" unless(defined $rv && $rv == 0);
  }
  
  # Debug version with separated debug symbols [EXPERIMENTAL]
  if ($dbg > 1) {
    my @bin = File::Find::Rule->file->name('*perl*.dll', 'perl.exe', 'wperl.exe', 'perl5*.exe')->in("$image_dir\\perl\\bin");
    my @lib = File::Find::Rule->file->name('*.dll')->in("$image_dir\\perl\\lib");

    my $ch = "$image_dir\\perl\\lib\\Config_heavy.pl";
    my $ch_content = read_file($ch, {binmode=>':raw'});
    $ch_content =~ s/(ccflags|optimize|ccflags_nolargefiles)(=.*?)-g -O2 -DDEBUGGING/$1$2-s -O2/sg;
    $ch_content =~ s/(lddlflags|ldflags|ldflags_nolargefiles)(=.*?)-g /$1$2-s /sg;

    if ($dbg eq '2') {
      $self->_strip_debug($_, 1) for (@bin); #keep *.debug files
      $self->_strip_debug($_, 1) for (@lib); #keep *.debug files
      my $ro = $self->_unset_ro($ch);
      write_file($ch, {binmode=>':raw'}, $ch_content);
      $self->_restore_ro($ch, $ro);
    }
    if ($dbg eq '3') {
      $self->_strip_debug($_, 1) for (@bin);
      $self->_strip_debug($_, 0) for (@lib); #do not keep *.debug files
      my $ro = $self->_unset_ro($ch);
      write_file($ch, {binmode=>':raw'}, $ch_content);
      $self->_restore_ro($ch, $ro);
    }
  }

  # Delete unwanted dirs
  remove_tree("$image_dir/perl/html") if -d "$image_dir/perl/html";
  remove_tree("$image_dir/perl/man")  if -d "$image_dir/perl/man";
  
  # copy the helper dll into perl's bin directory.
  my $from;
  $from = catfile($image_dir, qw/c bin libgcc_s_dw2-1.dll/);
  copy($from, catfile($image_dir, qw/perl bin libgcc_s_dw2-1.dll/)) if -f $from;
  $from = catfile($image_dir, qw/c bin libgcc_s_seh-1.dll/);
  copy($from, catfile($image_dir, qw/perl bin libgcc_s_seh-1.dll/)) if -f $from;
  $from = catfile($image_dir, qw/c bin libgcc_s_sjlj-1.dll/);
  copy($from, catfile($image_dir, qw/perl bin libgcc_s_sjlj-1.dll/)) if -f $from;
  $from = catfile($image_dir, qw/c bin libstdc++-6.dll/);
  copy($from, catfile($image_dir, qw/perl bin libstdc++-6.dll/)) if -f $from;
  $from = catfile($image_dir, qw/c bin libwinpthread-1.dll/);
  copy($from, catfile($image_dir, qw/perl bin libwinpthread-1.dll/)) if -f $from;
  $from = catfile($image_dir, qw/c bin libmcfgthread-1.dll/);
  copy($from, catfile($image_dir, qw/perl bin libmcfgthread-1.dll/)) if -f $from;

  # Delete a2p.exe (Can't relocate a binary).
  my $a = catfile($image_dir, 'perl', 'bin', 'a2p.exe');
  if (-f $a) {
    $self->boss->message(3, "removing file '$a'");
    unlink $a or die "ERROR: Could not delete '$a'";
  }

  die "FATAL: perl.exe not properly installed" unless -f catfile($image_dir, qw/perl bin perl.exe/);
  
  # Create some missing directories
  my @d = ( catdir($image_dir, qw/perl vendor lib/),
            catdir($image_dir, qw/perl site bin/),
            catdir($image_dir, qw/perl site lib/) );
  for (@d) { make_path($_) unless -d $_; }
 
  # store some output data
  $self->{data}->{output}->{perl_version} = $version;
  
  #XXX-TODO store perl -V
  #$self->{data}->{output}->{perl_version} = `perl -V`;

  return 1;
}

sub test {
  #XXX-FIXME maybe some kind of post_check
}

sub _strip_debug {
  my ($self, $fullpath, $keep_debug) = @_;
  if ($keep_debug) {
    my $fullpath_dbg = "$fullpath.debug";
    my $ro = $self->_unset_ro($fullpath);
    
    ### not correct: warning: section .gnu_debuglink not found in C:\strawberry\perl\bin\perl520.dll.debug
    #$self->execute_standard(['objcopy', '--only-keep-debug', $fullpath, $fullpath_dbg]);
    #$self->execute_standard(['objcopy', '--strip-debug', $fullpath]);
    #$self->execute_standard(['objcopy', "--add-gnu-debuglink=$fullpath_dbg", $fullpath]);
    
    ### workaround from https://sourceware.org/bugzilla/show_bug.cgi?id=14527
    $self->execute_standard(['objcopy', '--only-keep-debug', $fullpath, $fullpath_dbg]);
    $self->execute_standard(['objcopy', "--add-gnu-debuglink=$fullpath_dbg", $fullpath]);
    $self->execute_standard(['objcopy', '--only-keep-debug', $fullpath, $fullpath_dbg]);
    $self->execute_standard(['objcopy', '--remove-section=.gnu_debuglink', $fullpath]);
    $self->execute_standard(['objcopy', '--strip-debug', $fullpath]);
    $self->execute_standard(['objcopy', "--add-gnu-debuglink=$fullpath_dbg", $fullpath]);
    
    $self->_restore_ro($fullpath, $ro);
  }
  else {
    my $ro = $self->_unset_ro($fullpath);
    $self->execute_standard(['objcopy', '--strip-debug', $fullpath]);
    $self->_restore_ro($fullpath, $ro);
  }
}

1;