local-lib5/lib/perl5/ExtUtils/Depends.pm

   1 #
   2 # $Id$
   3 #
   4
   5 package ExtUtils::Depends;
   6
   7 use strict;
   8 use warnings;
   9 use Carp;
  10 use File::Find;
  11 use File::Spec;
  12 use Data::Dumper;
  13
  14 our $VERSION = '0.302';
  15
  16 sub import {
  17         my $class = shift;
  18         return unless @_;
  19         die "$class version $_[0] is required--this is only version $VERSION"
  20                 if $VERSION < $_[0];
  21 }
  22
  23 sub new {
  24         my ($class, $name, @deps) = @_;
  25         my $self = bless {
  26                 name => $name,
  27                 deps => {},
  28                 inc => [],
  29                 libs => '',
  30
  31                 pm => {},
  32                 typemaps => [],
  33                 xs => [],
  34                 c => [],
  35         }, $class;
  36
  37         $self->add_deps (@deps);
  38
  39         # attempt to load these now, so we'll find out as soon as possible
  40         # whether the dependencies are valid.  we'll load them again in
  41         # get_makefile_vars to catch any added between now and then.
  42         $self->load_deps;
  43
  44         return $self;
  45 }
  46
  47 sub add_deps {
  48         my $self = shift;
  49         foreach my $d (@_) {
  50                 $self->{deps}{$d} = undef
  51                         unless $self->{deps}{$d};
  52         }
  53 }
  54
  55 sub get_deps {
  56         my $self = shift;
  57         $self->load_deps; # just in case
  58
  59         return %{$self->{deps}};
  60 }
  61
  62 sub set_inc {
  63         my $self = shift;
  64         push @{ $self->{inc} }, @_;
  65 }
  66
  67 sub set_libs {
  68         my ($self, $newlibs) = @_;
  69         $self->{libs} = $newlibs;
  70 }
  71
  72 sub add_pm {
  73         my ($self, %pm) = @_;
  74         while (my ($key, $value) = each %pm) {
  75                 $self->{pm}{$key} = $value;
  76         }
  77 }
  78
  79 sub _listkey_add_list {
  80         my ($self, $key, @list) = @_;
  81         $self->{$key} = [] unless $self->{$key};
  82         push @{ $self->{$key} }, @list;
  83 }
  84
  85 sub add_xs       { shift->_listkey_add_list ('xs',       @_) }
  86 sub add_c        { shift->_listkey_add_list ('c',        @_) }
  87 sub add_typemaps {
  88         my $self = shift;
  89         $self->_listkey_add_list ('typemaps', @_);
  90         $self->install (@_);
  91 }
  92
  93 # no-op, only used for source back-compat
  94 sub add_headers { carp "add_headers() is a no-op" }
  95
  96 ####### PRIVATE
  97 sub basename { (File::Spec->splitdir ($_[0]))[-1] }
  98 # get the name in Makefile syntax.
  99 sub installed_filename {
 100         my $self = shift;
 101         return '$(INST_ARCHLIB)/$(FULLEXT)/Install/'.basename ($_[0]);
 102 }
 103
 104 sub install {
 105         # install things by adding them to the hash of pm files that gets
 106         # passed through WriteMakefile's PM key.
 107         my $self = shift;
 108         foreach my $f (@_) {
 109                 $self->add_pm ($f, $self->installed_filename ($f));
 110         }
 111 }
 112
 113 sub save_config {
 114         use Data::Dumper;
 115         use IO::File;
 116
 117         my ($self, $filename) = @_;
 118
 119         my $file = IO::File->new (">".$filename)
 120                 or croak "can't open '$filename' for writing: $!\n";
 121
 122         print $file "package $self->{name}\::Install::Files;\n\n";
 123         # for modern stuff
 124         print $file "".Data::Dumper->Dump([{
 125                 inc => join (" ", @{ $self->{inc} }),
 126                 libs => $self->{libs},
 127                 typemaps => [ map { basename $_ } @{ $self->{typemaps} } ],
 128                 deps => [keys %{ $self->{deps} }],
 129         }], ['self']);
 130         # for ancient stuff
 131         print $file "\n\n# this is for backwards compatiblity\n";
 132         print $file "\@deps = \@{ \$self->{deps} };\n";
 133         print $file "\@typemaps = \@{ \$self->{typemaps} };\n";
 134         print $file "\$libs = \$self->{libs};\n";
 135         print $file "\$inc = \$self->{inc};\n";
 136         # this is riduculous, but old versions of ExtUtils::Depends take
 137         # first $loadedmodule::CORE and then $INC{$file} --- the fallback
 138         # includes the Filename.pm, which is not useful.  so we must add
 139         # this crappy code.  we don't worry about portable pathnames,
 140         # as the old code didn't either.
 141         (my $mdir = $self->{name}) =~ s{::}{/}g;
 142         print $file <<"EOT";
 143
 144         \$CORE = undef;
 145         foreach (\@INC) {
 146                 if ( -f \$_ . "/$mdir/Install/Files.pm") {
 147                         \$CORE = \$_ . "/$mdir/Install/";
 148                         last;
 149                 }
 150         }
 151 EOT
 152
 153         print $file "\n1;\n";
 154
 155         close $file;
 156
 157         # we need to ensure that the file we just created gets put into
 158         # the install dir with everything else.
 159         #$self->install ($filename);
 160         $self->add_pm ($filename, $self->installed_filename ('Files.pm'));
 161 }
 162
 163 sub load {
 164         my $dep = shift;
 165         my @pieces = split /::/, $dep;
 166         my @suffix = qw/ Install Files /;
 167         my $relpath = File::Spec->catfile (@pieces, @suffix) . '.pm';
 168         my $depinstallfiles = join "::", @pieces, @suffix;
 169         eval {
 170                 require $relpath
 171         } or die " *** Can't load dependency information for $dep:\n   $@\n";
 172         #
 173         #print Dumper(\%INC);
 174
 175         # effectively $instpath = dirname($INC{$relpath})
 176         @pieces = File::Spec->splitdir ($INC{$relpath});
 177         pop @pieces;
 178         my $instpath = File::Spec->catdir (@pieces);
 179
 180         no strict;
 181
 182         croak "No dependency information found for $dep"
 183                 unless $instpath;
 184
 185         if (not File::Spec->file_name_is_absolute ($instpath)) {
 186                 $instpath = File::Spec->rel2abs ($instpath);
 187         }
 188
 189         my @typemaps = map {
 190                 File::Spec->rel2abs ($_, $instpath)
 191         } @{"$depinstallfiles\::typemaps"};
 192
 193         {
 194                 instpath => $instpath,
 195                 typemaps => \@typemaps,
 196                 inc      => "-I$instpath ".${"$depinstallfiles\::inc"},
 197                 libs     => ${"$depinstallfiles\::libs"},
 198                 # this will not exist when loading files from old versions
 199                 # of ExtUtils::Depends.
 200                 (exists ${"$depinstallfiles\::"}{deps}
 201                   ? (deps => \@{"$depinstallfiles\::deps"})
 202                   : ()),
 203         }
 204 }
 205
 206 sub load_deps {
 207         my $self = shift;
 208         my @load = grep { not $self->{deps}{$_} } keys %{ $self->{deps} };
 209         foreach my $d (@load) {
 210                 my $dep = load ($d);
 211                 $self->{deps}{$d} = $dep;
 212                 if ($dep->{deps}) {
 213                         foreach my $childdep (@{ $dep->{deps} }) {
 214                                 push @load, $childdep
 215                                         unless
 216                                                 $self->{deps}{$childdep}
 217                                         or
 218                                                 grep {$_ eq $childdep} @load;
 219                         }
 220                 }
 221         }
 222 }
 223
 224 sub uniquify {
 225         my %seen;
 226         # we use a seen hash, but also keep indices to preserve
 227         # first-seen order.
 228         my $i = 0;
 229         foreach (@_) {
 230                 $seen{$_} = ++$i
 231                         unless exists $seen{$_};
 232         }
 233         #warn "stripped ".(@_ - (keys %seen))." redundant elements\n";
 234         sort { $seen{$a} <=> $seen{$b} } keys %seen;
 235 }
 236
 237
 238 sub get_makefile_vars {
 239         my $self = shift;
 240
 241         # collect and uniquify things from the dependencies.
 242         # first, ensure they are completely loaded.
 243         $self->load_deps;
 244
 245         ##my @defbits = map { split } @{ $self->{defines} };
 246         my @incbits = map { split } @{ $self->{inc} };
 247         my @libsbits = split /\s+/, $self->{libs};
 248         my @typemaps = @{ $self->{typemaps} };
 249         foreach my $d (keys %{ $self->{deps} }) {
 250                 my $dep = $self->{deps}{$d};
 251                 #push @defbits, @{ $dep->{defines} };
 252                 push @incbits, @{ $dep->{defines} } if $dep->{defines};
 253                 push @incbits, split /\s+/, $dep->{inc} if $dep->{inc};
 254                 push @libsbits, split /\s+/, $dep->{libs} if $dep->{libs};
 255                 push @typemaps, @{ $dep->{typemaps} } if $dep->{typemaps};
 256         }
 257
 258         # we have a fair bit of work to do for the xs files...
 259         my @clean = ();
 260         my @OBJECT = ();
 261         my %XS = ();
 262         foreach my $xs (@{ $self->{xs} }) {
 263                 (my $c = $xs) =~ s/\.xs$/\.c/i;
 264                 (my $o = $xs) =~ s/\.xs$/\$(OBJ_EXT)/i;
 265                 $XS{$xs} = $c;
 266                 push @OBJECT, $o;
 267                 # according to the MakeMaker manpage, the C files listed in
 268                 # XS will be added automatically to the list of cleanfiles.
 269                 push @clean, $o;
 270         }
 271
 272         # we may have C files, as well:
 273         foreach my $c (@{ $self->{c} }) {
 274                 (my $o = $c) =~ s/\.c$/\$(OBJ_EXT)/i;
 275                 push @OBJECT, $o;
 276                 push @clean, $o;
 277         }
 278
 279         my %vars = (
 280                 INC => join (' ', uniquify @incbits),
 281                 LIBS => join (' ', uniquify $self->find_extra_libs, @libsbits),
 282                 TYPEMAPS => [@typemaps],
 283         );
 284
 285         $self->build_dll_lib(\%vars) if $^O =~ /MSWin32/;
 286
 287         # we don't want to provide these if there is no data in them;
 288         # that way, the caller can still get default behavior out of
 289         # MakeMaker when INC, LIBS and TYPEMAPS are all that are required.
 290         $vars{PM} = $self->{pm}
 291                 if %{ $self->{pm} };
 292         $vars{clean} = { FILES => join (" ", @clean), }
 293                 if @clean;
 294         $vars{OBJECT} = join (" ", @OBJECT)
 295                 if @OBJECT;
 296         $vars{XS} = \%XS
 297                 if %XS;
 298
 299         %vars;
 300 }
 301
 302 sub build_dll_lib {
 303         my ($self, $vars) = @_;
 304         $vars->{macro} ||= {};
 305         $vars->{macro}{'INST_DYNAMIC_LIB'} =
 306                 '$(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)';
 307 }
 308
 309 sub find_extra_libs {
 310         my $self = shift;
 311
 312         my %mappers = (
 313                 MSWin32 => sub { $_[0] . '\.(?:lib|a)' },
 314                 cygwin  => sub { $_[0] . '\.dll'},
 315         );
 316         my $mapper = $mappers{$^O};
 317         return () unless defined $mapper;
 318
 319         my @found_libs = ();
 320         foreach my $name (keys %{ $self->{deps} }) {
 321                 (my $stem = $name) =~ s/^.*:://;
 322                 my $lib = $mapper->($stem);
 323                 my $pattern = qr/$lib$/;
 324
 325                 my $matching_dir;
 326                 my $matching_file;
 327                 find (sub {
 328                         if ((not $matching_file) && /$pattern/) {;
 329                                 $matching_dir = $File::Find::dir;
 330                                 $matching_file = $File::Find::name;
 331                         }
 332                 }, map { -d $_ ? ($_) : () } @INC); # only extant dirs
 333
 334                 if ($matching_file && -f $matching_file) {
 335                         push @found_libs, ('-L' . $matching_dir, '-l' . $stem);
 336                         next;
 337                 }
 338         }
 339
 340         return @found_libs;
 341 }
 342
 343 # Hook into ExtUtils::MakeMaker to create an import library on MSWin32 when gcc
 344 # is used.  FIXME: Ideally, this should be done in EU::MM itself.
 345 package # wrap to fool the CPAN indexer
 346         ExtUtils::MM;
 347 use Config;
 348 sub static_lib {
 349         my $base = shift->SUPER::static_lib(@_);
 350
 351         return $base unless $^O =~ /MSWin32/ && $Config{cc} =~ /^gcc/i;
 352
 353         return <<'__EOM__';
 354 # This isn't actually a static lib, it just has the same name on Win32.
 355 $(INST_DYNAMIC_LIB): $(INST_DYNAMIC)
 356         dlltool --def $(EXPORT_LIST) --output-lib $@ --dllname $(BASEEXT).$(SO) $(INST_DYNAMIC)
 357
 358 dynamic:: $(INST_DYNAMIC_LIB)
 359 __EOM__
 360 }
 361
 362 1;
 363
 364 __END__
 365
 366 =head1 NAME
 367
 368 ExtUtils::Depends - Easily build XS extensions that depend on XS extensions
 369
 370 =head1 SYNOPSIS
 371
 372         use ExtUtils::Depends;
 373         $package = new ExtUtils::Depends ('pkg::name', 'base::package')
 374         # set the flags and libraries to compile and link the module
 375         $package->set_inc("-I/opt/blahblah");
 376         $package->set_libs("-lmylib");
 377         # add a .c and an .xs file to compile
 378         $package->add_c('code.c');
 379         $package->add_xs('module-code.xs');
 380         # add the typemaps to use
 381         $package->add_typemaps("typemap");
 382         # install some extra data files and headers
 383         $package->install (qw/foo.h data.txt/);
 384         # save the info
 385         $package->save_config('Files.pm');
 386
 387         WriteMakefile(
 388                 'NAME' => 'Mymodule',
 389                 $package->get_makefile_vars()
 390         );
 391
 392 =head1 DESCRIPTION
 393
 394 This module tries to make it easy to build Perl extensions that use
 395 functions and typemaps provided by other perl extensions. This means
 396 that a perl extension is treated like a shared library that provides
 397 also a C and an XS interface besides the perl one.
 398
 399 This works as long as the base extension is loaded with the RTLD_GLOBAL
 400 flag (usually done with a
 401
 402         sub dl_load_flags {0x01}
 403
 404 in the main .pm file) if you need to use functions defined in the module.
 405
 406 The basic scheme of operation is to collect information about a module
 407 in the instance, and then store that data in the Perl library where it
 408 may be retrieved later.  The object can also reformat this information
 409 into the data structures required by ExtUtils::MakeMaker's WriteMakefile
 410 function.
 411
 412 When creating a new Depends object, you give it a name, which is the name
 413 of the module you are building.   You can also specify the names of modules
 414 on which this module depends.  These dependencies will be loaded
 415 automatically, and their typemaps, header files, etc merged with your new
 416 object's stuff.  When you store the data for your object, the list of
 417 dependencies are stored with it, so that another module depending on your
 418 needn't know on exactly which modules yours depends.
 419
 420 For example:
 421
 422   Gtk2 depends on Glib
 423
 424   Gnome2::Canvas depends on Gtk2
 425
 426   ExtUtils::Depends->new ('Gnome2::Canvas', 'Gtk2');
 427      this command automatically brings in all the stuff needed
 428      for Glib, since Gtk2 depends on it.
 429
 430
 431 =head1 METHODS
 432
 433 =over
 434
 435 =item $object = ExtUtils::Depends->new($name, @deps)
 436
 437 Create a new depends object named I<$name>.  Any modules listed in I<@deps>
 438 (which may be empty) are added as dependencies and their dependency
 439 information is loaded.  An exception is raised if any dependency information
 440 cannot be loaded.
 441
 442 =item $depends->add_deps (@deps)
 443
 444 Add modules listed in I<@deps> as dependencies.
 445
 446 =item (hashes) = $depends->get_deps
 447
 448 Fetch information on the dependencies of I<$depends> as a hash of hashes,
 449 which are dependency information indexed by module name.  See C<load>.
 450
 451 =item $depends->set_inc (@newinc)
 452
 453 Add strings to the includes or cflags variables.
 454
 455 =item $depends->set_libs (@newlibs)
 456
 457 Add strings to the libs (linker flags) variable.
 458
 459 =item $depends->add_pm (%pm_files)
 460
 461 Add files to the hash to be passed through ExtUtils::WriteMakefile's
 462 PM key.
 463
 464 =item $depends->add_xs (@xs_files)
 465
 466 Add xs files to be compiled.
 467
 468 =item $depends->add_c (@c_files)
 469
 470 Add C files to be compiled.
 471
 472 =item $depends->add_typemaps (@typemaps)
 473
 474 Add typemap files to be used and installed.
 475
 476 =item $depends->add_headers (list)
 477
 478 No-op, for backward compatibility.
 479
 480 =item $depends->install (@files)
 481
 482 Install I<@files> to the data directory for I<$depends>.
 483
 484 This actually works by adding them to the hash of pm files that gets
 485 passed through WriteMakefile's PM key.
 486
 487 =item $depends->save_config ($filename)
 488
 489 Save the important information from I<$depends> to I<$filename>, and
 490 set it up to be installed as I<name>::Install::Files.
 491
 492 Note: the actual value of I<$filename> seems to be irrelevant, but its
 493 usage is kept for backward compatibility.
 494
 495 =item hash = $depends->get_makefile_vars
 496
 497 Return the information in I<$depends> in a format digestible by
 498 WriteMakefile.
 499
 500 This sets at least the following keys:
 501
 502         INC
 503         LIBS
 504         TYPEMAPS
 505         PM
 506
 507 And these if there is data to fill them:
 508
 509         clean
 510         OBJECT
 511         XS
 512
 513 =item hashref = ExtUtils::Depends::load (name)
 514
 515 Load and return dependency information for I<name>.  Croaks if no such
 516 information can be found.  The information is returned as an anonymous
 517 hash containing these keys:
 518
 519 =over
 520
 521 =item instpath
 522
 523 The absolute path to the data install directory for this module.
 524
 525 =item typemaps
 526
 527 List of absolute pathnames for this module's typemap files.
 528
 529 =item inc
 530
 531 CFLAGS string for this module.
 532
 533 =item libs
 534
 535 LIBS string for this module.
 536
 537 =item deps
 538
 539 List of modules on which this one depends.  This key will not exist when
 540 loading files created by old versions of ExtUtils::Depends.
 541
 542 =back
 543
 544 =item $depends->load_deps
 545
 546 Load I<$depends> dependencies, by calling C<load> on each dependency module.
 547 This is usually done for you, and should only be needed if you want to call
 548 C<get_deps> after calling C<add_deps> manually.
 549
 550 =back
 551
 552
 553 =head1 BUGS
 554
 555 Version 0.2 discards some of the more esoteric features provided by the
 556 older versions.  As they were completely undocumented, and this module
 557 has yet to reach 1.0, this may not exactly be a bug.
 558
 559 This module is tightly coupled to the ExtUtils::MakeMaker architecture.
 560
 561 =head1 SEE ALSO
 562
 563 ExtUtils::MakeMaker.
 564
 565 =head1 AUTHOR
 566
 567 Paolo Molaro <lupus at debian dot org> wrote the original version for
 568 Gtk-Perl.  muppet <scott at asofyet dot org> rewrote the innards for
 569 version 0.2, borrowing liberally from Paolo's code.
 570
 571 =head1 MAINTAINER
 572
 573 The Gtk2 project, http://gtk2-perl.sf.net/
 574
 575 =head1 LICENSE
 576
 577 This library is free software; you may redistribute it and/or modify it
 578 under the same terms as Perl itself.
 579
 580 =cut
 581