vcs.maemo.org Git - pkg-perl/blob - deb-src/libalien-wxwidgets-perl/libalien-wxwidgets-perl-0.50/inc/My/Build/Base.pm

   1 package My::Build::Base;
   2
   3 use strict;
   4 use base qw(Module::Build);
   5 use My::Build::Utility qw(awx_arch_file awx_touch);
   6 use Alien::wxWidgets::Utility qw(awx_sort_config awx_grep_config);
   7 use File::Path ();
   8 use File::Basename ();
   9 use Fatal qw(open close unlink);
  10 use Data::Dumper;
  11 use File::Glob qw(bsd_glob);
  12
  13 sub ACTION_build {
  14     my $self = shift;
  15     # try to make "perl Makefile.PL && make test" work
  16     # but avoid doubly building wxWidgets when doing
  17     # "perl Makefile.PL && make && make test"
  18     unlink 'configured' if -f 'configured';
  19     $self->SUPER::ACTION_build;
  20 }
  21
  22 sub ACTION_code {
  23     my $self = shift;
  24
  25     $self->SUPER::ACTION_code;
  26     # install_only is set when a wxWidgets build is already configured
  27     # with Alien::wxWidgets
  28     return if $self->notes( 'install_only' );
  29     # see comment in ACTION_build for why 'configured' is used
  30     return if -f 'configured';
  31     $self->depends_on( 'build_wx' );
  32     $self->create_config_file( awx_arch_file( 'Config/Config.pm' ) );
  33     $self->install_wxwidgets;
  34     # see comment in ACTION_build for why 'configured' is used
  35     awx_touch( 'configured' );
  36     $self->add_to_cleanup( 'configured' );
  37 }
  38
  39 sub ACTION_build_wx {
  40     my $self = shift;
  41
  42     if( $self->notes( 'build_wx' ) ) {
  43         $self->fetch_wxwidgets;
  44         $self->extract_wxwidgets;
  45         $self->massage_environment;
  46         $self->build_wxwidgets;
  47         $self->massage_environment; # twice on purpose
  48     }
  49 }
  50
  51 sub ACTION_build_perl {
  52     my $self = shift;
  53
  54     $self->SUPER::ACTION_build;
  55     $self->massage_environment;
  56     $self->create_config_file( awx_arch_file( 'Config/Config.pm' ) );
  57 }
  58
  59 sub ACTION_install_wx {
  60     my $self = shift;
  61
  62     $self->depends_on( 'build_perl' );
  63     $self->install_wxwidgets;
  64 }
  65
  66 sub ACTION_install {
  67     my $self = shift;
  68
  69     $self->SUPER::ACTION_install;
  70     $self->install_system_wxwidgets;
  71 }
  72
  73 sub ACTION_distcheck {
  74     my $self = shift;
  75     my $data = $self->notes( 'build_data' );
  76
  77     foreach my $p ( qw(msw mac unix) ) {
  78         next unless exists $data->{$p};
  79
  80         foreach my $c ( qw(unicode ansi) ) {
  81             next unless exists $data->{$p}{$c};
  82
  83             foreach my $f ( @{$data->{$p}{$c}} ) {
  84                 my $file = File::Spec->catfile( 'patches', $f );
  85
  86                 warn 'Missing patch file: ', $file, "\n" unless -f $file;
  87             }
  88         }
  89     }
  90
  91     $self->SUPER::ACTION_distcheck;
  92 }
  93
  94 sub awx_key {
  95     my( $self ) = @_;
  96
  97     die unless $self->{awx_key};
  98
  99     return $self->{awx_key};
 100 }
 101
 102 sub _version_2_dec {
 103     my( $class, $ver ) = @_;
 104     my $dec;
 105
 106     $ver =~ m/^(\d)(\d)$/ and
 107       $dec = $1 + $2 / 1000;
 108     $ver =~ m/^(\d)(\d)(\d+)$/ and
 109       $dec = $1 + $2 / 1000 + $3 / 1000000;
 110     $ver =~ m/^(\d)(\d+)_(\d+)$/ and
 111       $dec = $1 + $2 / 1000 + $3 / 1000000;
 112     $ver =~ m/^(\d+)\.(\d+)\.(\d+)$/ and
 113       $dec = $1 + $2 / 1000 + $3 / 1000000;
 114
 115     return sprintf( "%.6f", $dec );
 116 }
 117
 118 sub _init_config {
 119     my( $self ) = @_;
 120     my %config = $self->awx_configure;
 121     my $ver = $self->awx_wx_config_data->{version};
 122
 123     $self->{awx_config} = \%config;
 124
 125     $config{version} = $self->_version_2_dec( $ver );
 126
 127     $config{compiler} = $ENV{CXX} || $self->awx_wx_config_data->{cxx};
 128     $config{linker} = $self->awx_wx_config_data->{ld};
 129     $config{config}{compiler_kind} = $self->notes( 'compiler_kind' ) ||
 130         $self->awx_compiler_kind( $config{compiler} );
 131     $config{config}{compiler_version} = $self->notes( 'compiler_version' ) ||
 132       $self->awx_compiler_version( $config{compiler} );
 133     $self->notes( 'compiler_kind' => $config{config}{compiler_kind} );
 134     $self->notes( 'compiler_version' => $config{config}{compiler_version} );
 135
 136     my $base = $self->awx_get_name
 137       ( toolkit          => $config{config}{toolkit},
 138         version          => $config{version},
 139         debug            => $self->awx_is_debug,
 140         unicode          => $self->awx_is_unicode,
 141         mslu             => $self->awx_is_mslu,
 142         compiler         => $config{config}{compiler_kind},
 143         compiler_version => $config{config}{compiler_version},
 144       );
 145
 146     $self->{awx_key} = $base;
 147
 148     $config{wx_base_directory} = $self->awx_wx_config_data->{wxdir}
 149       if $self->awx_wx_config_data->{wxdir};
 150     $config{alien_base} = $self->{awx_base} = $base;
 151     $config{alien_package} = "Alien::wxWidgets::Config::${base}";
 152
 153     return %config;
 154 }
 155
 156 sub create_config_file {
 157     my( $self, $file ) = @_;
 158
 159     my $directory = File::Basename::dirname( $file );
 160     my %config = $self->_init_config;
 161     my $base = $self->awx_key;
 162
 163     my $body = Data::Dumper->Dump( [ \%config ] );
 164     $body =~ s/rEpLaCe/$base/g;
 165
 166     File::Path::mkpath( $directory ) or die "mkpath '$directory': $!"
 167         unless -d $directory;
 168     open my $fh, '> ' . File::Spec->catfile( $directory, $base . '.pm' );
 169
 170     print $fh <<"EOT";
 171 package $config{alien_package};
 172
 173 EOT
 174
 175     print $fh <<'EOT';
 176 use strict;
 177
 178 our %VALUES;
 179
 180 {
 181     no strict 'vars';
 182     %VALUES = %{
 183 EOT
 184
 185     print $fh $body ;
 186
 187     print $fh <<'EOT';
 188     };
 189 }
 190
 191 my $key = substr __PACKAGE__, 1 + rindex __PACKAGE__, ':';
 192 EOT
 193
 194     print $fh <<'EOT' if $self->notes( 'mk_portable' ) && ( $^O =~ /^MSWin/ );
 195
 196 my ($portablebase);
 197 my $wxwidgetspath = __PACKAGE__ . '.pm';
 198 $wxwidgetspath =~ s/::/\//g;
 199
 200 for (@INC) {
 201     if( -f qq($_/$wxwidgetspath ) ) {
 202         $portablebase = qq($_/Alien/wxWidgets/$key);
 203         last;
 204     }
 205 }
 206
 207 if( $portablebase ) {
 208     $portablebase =~ s{/}{\\}g;
 209     my $portablelibpath = qq($portablebase\\lib);
 210     my $portableincpath = qq($portablebase\\include);
 211
 212     $VALUES{include_path} = qq{-I$portablelibpath -I$portableincpath};
 213     $VALUES{link_libraries} =~ s{-L\S+\s}{-L$portablelibpath };
 214     $VALUES{shared_library_path} = $portablelibpath;
 215     $VALUES{wx_base_directory} = $portablebase;
 216     $VALUES{prefix} = $portablebase;
 217 }
 218 EOT
 219
 220     print $fh <<'EOT';
 221
 222 sub values { %VALUES, key => $key }
 223
 224 sub config {
 225    +{ %{$VALUES{config}},
 226       package       => __PACKAGE__,
 227       key           => $key,
 228       version       => $VALUES{version},
 229       }
 230 }
 231
 232 1;
 233 EOT
 234
 235     close $fh;
 236 }
 237
 238 sub fetch_wxwidgets {
 239     my $self = shift;
 240
 241     return if -f $self->notes( 'build_data' )->{data}{archive};
 242     require File::Fetch;
 243
 244     print "Fetching wxWidgets...\n";
 245     print "fetching from: ", $self->notes( 'build_data' )->{data}{url}, "\n";
 246
 247     my $path = File::Fetch->new
 248       ( uri => $self->notes( 'build_data' )->{data}{url} )->fetch;
 249     die 'Unable to fetch archive' unless $path;
 250 }
 251
 252 sub extract_wxwidgets {
 253     my $self = shift;
 254
 255     return if -d $self->notes( 'build_data' )->{data}{directory};
 256     my $archive = $self->notes( 'build_data' )->{data}{archive};
 257
 258     print "Extracting wxWidgets...\n";
 259
 260     require Archive::Extract;
 261     $Archive::Extract::PREFER_BIN = 1;
 262     my $ae = Archive::Extract->new( archive => $archive );
 263
 264     die 'Error: ', $ae->error unless $ae->extract;
 265
 266     $self->patch_wxwidgets;
 267 }
 268
 269 sub patch_wxwidgets {
 270     my $self = shift;
 271     my $old_dir = Cwd::cwd();
 272     my @patches = $self->awx_wx_patches;
 273
 274     print "Patching wxWidgets...\n";
 275
 276     my $wx_dir = $self->notes( 'build_data' )->{data}{directory};
 277     my $build_dir = File::Spec->rel2abs( $wx_dir );
 278     chdir $wx_dir;
 279
 280     foreach my $i ( @patches ) {
 281         print "Applying patch: ", $i, "\n";
 282         my $cmd = $self->_patch_command( $build_dir, $i );
 283         print $cmd, "\n";
 284         system $cmd and die 'Error: ', $?;
 285     }
 286
 287     chdir $old_dir;
 288 }
 289
 290 sub _patch_command {
 291     my( $self, $base_dir, $patch_file ) = @_;
 292
 293     $patch_file = File::Spec->abs2rel( $patch_file, $base_dir );
 294     my $cmd = $^X . ' ' . File::Spec->catfile( File::Spec->updir,
 295                                                qw(inc bin patch) )
 296       . " -N -p0 -u -b .bak < $patch_file";
 297
 298     return $cmd;
 299 }
 300
 301 sub build_wxwidgets {
 302     die "Don't know how to build wxWidgets";
 303 }
 304
 305 sub install_wxwidgets {
 306     return unless $_[0]->notes( 'build_wx' );
 307     die "Don't know how to build wxWidgets";
 308 }
 309
 310 sub install_system_wxwidgets { }
 311
 312 sub awx_configure {
 313     my $self = shift;
 314     return %{$self->{awx_config}} if $self->{awx_config};
 315
 316     my %config;
 317
 318     $config{config}{debug} = $self->awx_is_debug;
 319     $config{config}{unicode} = $self->awx_is_unicode;
 320     $config{config}{mslu} = $self->awx_is_mslu;
 321     $config{config}{build} = $self->awx_is_monolithic ? 'mono' : 'multi';
 322     $config{link_flags} = '';
 323     $config{c_flags} = '';
 324
 325     return %config;
 326 }
 327
 328 sub wx_config {
 329     my $self = shift;
 330     my $data = $self->awx_wx_config_data;
 331
 332     foreach ( @_ ) {
 333         warn "Undefined key '", $_, "' in wx_config"
 334           unless defined $data->{$_};
 335     }
 336
 337     return @{$data}{@_};
 338 }
 339
 340 sub awx_monolithic { $_[0]->args( 'wxWidgets-monolithic' ) ? 1 : 0 }
 341 sub awx_is_monolithic { $_[0]->awx_monolithic }
 342 sub awx_debug { $_[0]->args( 'wxWidgets-debug' ) ? 1 : 0 }
 343 sub awx_is_debug { $_[0]->awx_debug }
 344 sub awx_unicode { $_[0]->notes( 'build_wx_unicode' )
 345                     || $_[0]->args( 'wxWidgets-unicode' ) ? 1 : 0 }
 346 sub awx_is_unicode { $_[0]->awx_unicode }
 347 sub awx_mslu { 0 }
 348 sub awx_is_mslu { $_[0]->awx_mslu }
 349 sub awx_static { $_[0]->args( 'wxWidgets-static' ) ? 1 : 0 }
 350 sub awx_is_static { $_[0]->awx_static }
 351 sub awx_universal { $_[0]->args( 'wxWidgets-universal' ) ? 1 : 0 }
 352 sub awx_is_universal { $_[0]->awx_universal }
 353 sub awx_get_package { local $_ = $_[0]; s/^My::Build:://; return $_ }
 354
 355 sub awx_wx_patches {
 356     my $self = shift;
 357     my $data = $self->notes( 'build_data' );
 358     my $toolkit = $^O eq 'MSWin32' ? 'msw' :
 359                   $^O eq 'darwin'  ? 'mac' :
 360                                      'unix';
 361     my $unicode = $self->awx_unicode ? 'unicode' : 'ansi';
 362
 363     return unless exists $data->{$toolkit} and $data->{$toolkit}{$unicode};
 364
 365     return map { File::Spec->rel2abs( File::Spec->catfile( 'patches', $_ ) ) }
 366                @{$data->{$toolkit}{$unicode}};
 367 }
 368
 369 sub awx_get_name {
 370     my( $self, %args ) = @_;
 371     my $e = sub { defined $_[0] ? ( $_[0] ) : () };
 372     my $pv = sub { join '.', map { 0 + ( $_ || 0 ) }
 373                                  ( $_[0] =~ /(\d+)\.(\d{1,3})(\d{0,3})/ ) } ;
 374     my $base = join '-', $args{toolkit}, $pv->( $args{version} ),
 375                    $e->( $args{debug} ? 'dbg' : undef ),
 376                    $e->( $args{unicode} ? 'uni' : undef ),
 377                    $e->( $args{mslu} ? 'mslu' : undef ),
 378                    $e->( $args{compiler} ),
 379                    $e->( $args{compiler_version} ),
 380                    ;
 381
 382     $base =~ s/\./_/g; $base =~ s/-/_/g;
 383
 384     return $base;
 385 }
 386
 387 sub awx_compiler_kind { 'nc' } # as in 'No Clue'
 388
 389 sub awx_compiler_version {
 390     return Alien::wxWidgets::Utility::awx_cc_abi_version( $_[1] );
 391 }
 392
 393 sub awx_path_search {
 394     my( $self, $file ) = @_;
 395
 396     foreach my $d ( File::Spec->path ) {
 397         my $full = File::Spec->catfile( $d, $file );
 398         # we are gonna use glob() to accept wildcards
 399         foreach my $f ( bsd_glob( $full ) ) {
 400             return $f if -f $f;
 401         }
 402     }
 403
 404     return;
 405 }
 406
 407 sub awx_uses_bakefile { 1 }
 408
 409 sub ACTION_ppmdist {
 410     my( $self ) = @_;
 411
 412     $self->awx_strip_dlls;
 413     $self->_system( 'perl script/make_ppm.pl' );
 414 }
 415
 416 sub _system {
 417     shift;
 418     my $ret;
 419
 420     $ret = @_ > 1 ? system @_ : system $_[0];
 421     $ret and croak "system: @_: $?";
 422 }
 423
 424 1;