view release on metacpan or  search on metacpan

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

      return 1;
    }
    elsif ($self->check_lib( [ 'iupmot', 'im', 'cdx11' ], $cflags, $lflags)) {
      print STDERR "- iupmot+im+cdx11 FOUND!\n";
      $self->notes('already_installed_lib', { lflags => "$lflags -liupmot -lim -lcdx11", cflags => $cflags } );
      return 1;
    }
  }
  print STDERR "- iup+im+cd not found (we have to build it from sources)!\n";
  return 0;
}

# check presence of header(s) specified as params
sub check_header {
  my ($self, $h, $cflags) = @_;
  $cflags ||= '';
  my @header = ref($h) ? @$h : ( $h );

  my ($fs, $src) = tempfile('tmpfileXXXXXX', SUFFIX => '.c', UNLINK => 1);
  my ($fo, $obj) = tempfile('tmpfileXXXXXX', SUFFIX => '.o', UNLINK => 1);
  my $inc = '';
  $inc .= "#include <$_>\n" foreach @header;
  syswrite($fs, <<MARKER); # write test source code
$inc
int demofunc(void) { return 0; }

MARKER
  close($fs);
  $src = $self->quote_literal($src);
  $obj = $self->quote_literal($obj);
  #Note: $Config{cc} might contain e.g. 'ccache cc' (FreeBSD 8.0)
  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;
}

sub run_output_std {
  my ($self, @cmd) = @_;
  print STDERR "CMD: " . join(' ',@cmd) . "\n";
  my $rv = run3(\@cmd, undef, undef, undef, { return_if_system_error => 1 } );
  my $success = ($rv == 1 && $? == 0) ? 1 : 0;
  print STDERR "- finished successfully\n" if ($success);
  return $success;
}

sub run_stdout2str {
  my ($self, @cmd) = @_;
  my $output;
  my $rv = run3(\@cmd, \undef, \$output, \undef, { return_if_system_error => 1 } );
  $output =~ s/[\r\n]*$//;
  return $output;
}

sub run_bothout2str {
  my ($self, @cmd) = @_;
  my $output;
  my $rv = run3(\@cmd, \undef, \$output, \$output, { return_if_system_error => 1 } );
  $output =~ s/[\r\n]*$//;
  return $output;
}

sub run_custom {
  my ($self, @cmd) = @_;
  my $rv;
  if ($self->notes('build_msgs')) {
    $rv = $self->run_output_std(@cmd);
  }
  else {
    $rv = $self->run_output_on_error($self->notes('build_msgs_limit'), @cmd);
  }
  warn "###WARN### error during run_custom()" unless $rv;
  return $rv;
}

sub find_file {
  my ($self, $dir, $re) = @_;
  my @files;
  $re ||= qr/.*/;
  {
    no warnings 'File::Find'; #hide warning "Can't opendir(...): Permission denied
    find({ wanted => sub { push @files, rel2abs($_) if /$re/ }, follow => 1, no_chdir => 1 , follow_skip => 2}, $dir);
  };
  return @files;
}

sub sort_libs {
  my ($self, @unsorted) = @_;
  my @wanted_order = qw/iupcontrols iup_pplot iup_plot iupcd iupgl iupglcontrols iup_mglplot iupim iupimglib iupole iupweb iuptuio iupwin iupmot iupgtk iup cdgl cdpdf cdwin cdx11 cdgdk cd ftgl freetype6 freetype freetype-6 pdflib im_fftw im_jp2 im_pr...
  my @sorted;
  my %u;