vcs.maemo.org Git - pkg-perl/blob - deb-src/libalien-wxwidgets-perl/libalien-wxwidgets-perl-0.50/lib/Alien/wxWidgets/Utility.pm

   1 package Alien::wxWidgets::Utility;
   2
   3 =head1 NAME
   4
   5 Alien::wxWidgets::Utility - INTERNAL: do not use
   6
   7 =cut
   8
   9 use strict;
  10 use base qw(Exporter);
  11 use Config;
  12 use File::Basename qw();
  13
  14 BEGIN {
  15     if( $^O eq 'MSWin32' && $Config{_a} ne $Config{lib_ext} ) {
  16         print STDERR <<EOT;
  17
  18 \$Config{_a} is '$Config{_a}' and \$Config{lib_ext} is '$Config{lib_ext}':
  19 they need to be equal for the build to succeed. If you are using ActivePerl
  20 with MinGW/GCC, please:
  21
  22 - install ExtUtils::FakeConfig
  23 - set PERL5OPT=-MConfig_m
  24 - rerun Build.PL
  25
  26 EOT
  27         exit 1;
  28     }
  29 }
  30
  31 our @EXPORT_OK = qw(awx_capture awx_cc_is_gcc awx_cc_version awx_cc_abi_version
  32                     awx_sort_config awx_grep_config awx_smart_config);
  33
  34 my $quotes = $^O =~ /MSWin32/ ? '"' : "'";
  35 my $compiler_checked = '';
  36
  37 sub _exename {
  38     return File::Basename::basename( lc $_[0], '.exe' );
  39 }
  40
  41 sub _warn_nonworking_compiler {
  42     my( $cc ) = @_;
  43
  44     return if $compiler_checked eq $cc;
  45
  46     eval { require ExtUtils::CBuilder; };
  47     return if $@; # avoid failing when called a Build.PL time
  48
  49     # a C++ compiler can act as a linker, except for MS cl.exe
  50     my $ld = _exename( $Config{cc} ) eq 'cl' ? 'link' : $cc;
  51     my $b = ExtUtils::CBuilder->new( config => { cc => $cc, ld => $ld },
  52                                      quiet  => 1,
  53                                      );
  54
  55     if( !$b->have_compiler ) {
  56         print STDERR <<EOT;
  57
  58 ATTENTION: It apperars '$cc' is not a working compiler, please make
  59 sure all necessary packages are installed.
  60
  61 EOT
  62         sleep 5;
  63     }
  64
  65     $compiler_checked = $cc;
  66 }
  67
  68 sub awx_capture {
  69     qx!$^X -e ${quotes}open STDERR, q[>&STDOUT]; exec \@ARGV${quotes} -- $_[0]!;
  70 }
  71
  72 sub awx_cc_is_msvc {
  73     my( $cc ) = @_;
  74
  75     return $^O =~ /MSWin32/ and $cc =~ /^cl/i;
  76 }
  77
  78 sub awx_cc_is_gcc {
  79     my( $cc ) = @_;
  80
  81     return    scalar( awx_capture( "$cc --version" ) =~ m/g(cc|\+\+)/i ) # 3.x
  82            || scalar( awx_capture( "$cc" ) =~ m/gcc/i );          # 2.95
  83 }
  84
  85 sub awx_cc_abi_version {
  86     my( $cc ) = @_;
  87
  88     _warn_nonworking_compiler( $cc );
  89
  90     my $is_gcc = awx_cc_is_gcc( $cc );
  91     my $is_msvc = awx_cc_is_msvc( $cc );
  92     return 0 unless $is_gcc || $is_msvc;
  93     my $ver = awx_cc_version( $cc );
  94     if( $is_gcc ) {
  95         return 0 unless $ver > 0;
  96         return '3.4' if $ver >= 3.4;
  97         return '3.2' if $ver >= 3.2;
  98         return $ver;
  99     } elsif( $is_msvc ) {
 100         return 0 if $ver < 7;
 101         return $ver;
 102     }
 103 }
 104
 105 sub awx_cc_version {
 106     my( $cc ) = @_;
 107
 108     _warn_nonworking_compiler( $cc );
 109
 110     my $is_gcc = awx_cc_is_gcc( $cc );
 111     my $is_msvc = awx_cc_is_msvc( $cc );
 112     return 0 unless $is_gcc || $is_msvc;
 113
 114     if( $is_gcc ) {
 115         my $ver = awx_capture( "$cc --version" );
 116         $ver =~ m/(\d+\.\d+)(?:\.\d+)?/ or return 0;
 117         return $1;
 118     } elsif( $is_msvc ) {
 119         my $ver = awx_capture( $cc );
 120         $ver =~ m/(\d+\.\d+)\.\d+/ or return 0;
 121         return 8.0 if $1 >= 14;
 122         return 7.1 if $1 >= 13.10;
 123         return 7.0 if $1 >= 13;
 124         return 6.0 if $1 >= 12;
 125         return 5.0 if $1 >= 11;
 126         return 0;
 127     }
 128 }
 129
 130 sub awx_compiler_kind {
 131     my( $cc ) = @_;
 132
 133     _warn_nonworking_compiler( $cc );
 134
 135     return 'gcc' if awx_cc_is_gcc( $cc );
 136     return 'cl'  if awx_cc_is_msvc( $cc );
 137
 138     return 'nc'; # as in 'No Clue'
 139 }
 140
 141 # sort a list of configurations by version, debug/release, unicode/ansi, mslu
 142 sub awx_sort_config {
 143     # comparison functions treating undef as 0 or ''
 144     # numerico comparison
 145     my $make_cmpn = sub {
 146         my $k = shift;
 147         sub { exists $a->{$k} && exists $b->{$k} ? $a->{$k} <=> $b->{$k} :
 148               exists $a->{$k}                    ? 1                     :
 149               exists $b->{$k}                    ? -1                    :
 150                                                    0 }
 151     };
 152     # string comparison
 153     my $make_cmps = sub {
 154         my $k = shift;
 155         sub { exists $a->{$k} && exists $b->{$k} ? $a->{$k} cmp $b->{$k} :
 156               exists $a->{$k}                    ? 1                     :
 157               exists $b->{$k}                    ? -1                    :
 158                                                    0 }
 159     };
 160     # reverse comparison
 161     my $rev = sub { my $cmp = shift; sub { -1 * &$cmp } };
 162     # compare by different criteria, using the first nonzero as tie-breaker
 163     my $crit_sort = sub {
 164         my @crit = @_;
 165         sub {
 166             foreach ( @crit ) {
 167                 my $cmp = &$_;
 168                 return $cmp if $cmp;
 169             }
 170
 171             return 0;
 172         }
 173     };
 174
 175     my $cmp = $crit_sort->( $make_cmpn->( 'version' ),
 176                             $rev->( $make_cmpn->( 'debug' ) ),
 177                             $make_cmpn->( 'unicode' ),
 178                             $make_cmpn->( 'mslu' ) );
 179
 180     return reverse sort $cmp @_;
 181 }
 182
 183 sub awx_grep_config {
 184     my( $cfgs ) = shift;
 185     my( %a ) = @_;
 186     # compare to a numeric range or value
 187     # low extreme included, high extreme excluded
 188     # if $a{key} = [ lo, hi ] then range else low extreme
 189     my $make_cmpr = sub {
 190         my $k = shift;
 191         sub {
 192             return 1 unless exists $a{$k};
 193             ref $a{$k} ? $a{$k}[0] <= $_->{$k} && $_->{$k} < $a{$k}[1] :
 194                          $a{$k}    <= $_->{$k};
 195         }
 196     };
 197     # compare for numeric equality
 198     my $make_cmpn = sub {
 199         my $k = shift;
 200         sub { exists $a{$k} ? $a{$k} == $_->{$k} : 1 }
 201     };
 202     # compare for string equality
 203     my $make_cmps = sub {
 204         my $k = shift;
 205         sub { exists $a{$k} ? $a{$k} eq $_->{$k} : 1 }
 206     };
 207     my $compare_tk = sub {
 208         return 1 unless exists $a{toolkit};
 209         my $atk = $a{toolkit} eq 'mac'   ? 'osx_carbon' :
 210                                            $a{toolkit};
 211         my $btk = $_->{toolkit} eq 'mac' ? 'osx_carbon' :
 212                                            $_->{toolkit};
 213         return $atk eq $btk;
 214     };
 215
 216     # note tha if the criteria was not supplied, the comparison is a noop
 217     my $wver = $make_cmpr->( 'version' );
 218     my $ckind = $make_cmps->( 'compiler_kind' );
 219     my $cver = $make_cmpn->( 'compiler_version' );
 220     my $tkit = $compare_tk;
 221     my $deb = $make_cmpn->( 'debug' );
 222     my $uni = $make_cmpn->( 'unicode' );
 223     my $mslu = $make_cmpn->( 'mslu' );
 224     my $key = $make_cmps->( 'key' );
 225
 226     grep { &$wver  } grep { &$ckind } grep { &$cver  }
 227     grep { &$tkit  } grep { &$deb   } grep { &$uni   }
 228     grep { &$mslu  } grep { &$key   }
 229          @{$cfgs}
 230 }
 231
 232 # automatically add compiler data unless the key was supplied
 233 sub awx_smart_config {
 234     my( %args ) = @_;
 235     # the key already identifies the configuration
 236     return %args if $args{key};
 237
 238     my $cc = $ENV{CXX} || $ENV{CC} || $Config{ccname} || $Config{cc};
 239     my $kind = awx_compiler_kind( $cc );
 240     my $version = awx_cc_abi_version( $cc );
 241
 242     $args{compiler_kind} ||= $kind;
 243     $args{compiler_version} ||= $version;
 244
 245     return %args;
 246 }
 247
 248 # allow to remap srings in the configuration; useful when building
 249 # archives
 250 my @prefixes;
 251
 252 BEGIN {
 253     if( $ENV{ALIEN_WX_PREFIXES} ) {
 254         my @kv = split /,\s*/, $ENV{ALIEN_WX_PREFIXES};
 255
 256         while( @kv ) {
 257             my( $match, $repl ) = ( shift( @kv ) || '', shift( @kv ) || '' );
 258
 259             push @prefixes, [ $match, $^O eq 'MSWin32' ?
 260                                           qr/\Q$match\E/i :
 261                                           qr/\Q$match\E/, $repl ];
 262         }
 263     }
 264 }
 265
 266 sub _awx_remap {
 267     my( $string ) = @_;
 268     return $string if ref $string;
 269     return $string if $Alien::wxWidgets::dont_remap;
 270
 271     foreach my $prefix ( @prefixes ) {
 272         my( $str, $rx, $repl ) = @$prefix;
 273
 274         $string =~ s{$rx(\S*)}{$repl$1}g;
 275     }
 276
 277     return $string;
 278 }
 279
 280 1;