lib/ExtUtils/Mksymlists.pm

   1 package ExtUtils::Mksymlists;
   2
   3 use 5.006_001;
   4 use strict qw[ subs refs ];
   5 # no strict 'vars';  # until filehandles are exempted
   6
   7 use Carp;
   8 use Exporter;
   9 use Config;
  10 our(@ISA, @EXPORT, $VERSION);
  11 @ISA = 'Exporter';
  12 @EXPORT = '&Mksymlists';
  13 $VERSION = substr q$Revision: 1.18 $, 10;
  14
  15 sub Mksymlists {
  16     my(%spec) = @_;
  17     my($osname) = $^O;
  18
  19     croak("Insufficient information specified to Mksymlists")
  20         unless ( $spec{NAME} or
  21                  ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );
  22
  23     $spec{DL_VARS} = [] unless $spec{DL_VARS};
  24     ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
  25     $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
  26     $spec{DL_FUNCS} = { $spec{NAME} => [] }
  27         unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
  28                  @{$spec{FUNCLIST}});
  29     if (defined $spec{DL_FUNCS}) {
  30         my($package);
  31         foreach $package (keys %{$spec{DL_FUNCS}}) {
  32             my($packprefix,$sym,$bootseen);
  33             ($packprefix = $package) =~ s/\W/_/g;
  34             foreach $sym (@{$spec{DL_FUNCS}->{$package}}) {
  35                 if ($sym =~ /^boot_/) {
  36                     push(@{$spec{FUNCLIST}},$sym);
  37                     $bootseen++;
  38                 }
  39                 else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); }
  40             }
  41             push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
  42         }
  43     }
  44
  45 #    We'll need this if we ever add any OS which uses mod2fname
  46 #    not as pseudo-builtin.
  47 #    require DynaLoader;
  48     if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
  49         $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
  50     }
  51
  52     if    ($osname eq 'aix') { _write_aix(\%spec); }
  53     elsif ($osname eq 'MacOS'){ _write_aix(\%spec) }
  54     elsif ($osname eq 'VMS') { _write_vms(\%spec) }
  55     elsif ($osname eq 'os2') { _write_os2(\%spec) }
  56     elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
  57     else { croak("Don't know how to create linker option file for $osname\n"); }
  58 }
  59
  60
  61 sub _write_aix {
  62     my($data) = @_;
  63
  64     rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
  65
  66     open(EXP,">$data->{FILE}.exp")
  67         or croak("Can't create $data->{FILE}.exp: $!\n");
  68     print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
  69     print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
  70     close EXP;
  71 }
  72
  73
  74 sub _write_os2 {
  75     my($data) = @_;
  76     require Config;
  77     my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
  78
  79     if (not $data->{DLBASE}) {
  80         ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
  81         $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
  82     }
  83     my $distname = $data->{DISTNAME} || $data->{NAME};
  84     $distname = "Distribution $distname";
  85     my $comment = "Perl (v$Config::Config{version}$threaded) module $data->{NAME}";
  86     if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') {
  87         $distname = 'perl5-porters@perl.org';
  88         $comment = "Core $comment";
  89     }
  90     $comment = "$comment (Perl-config: $Config{config_args})";
  91     $comment = substr($comment, 0, 200) . "...)" if length $comment > 203;
  92     rename "$data->{FILE}.def", "$data->{FILE}_def.old";
  93
  94     open(DEF,">$data->{FILE}.def")
  95         or croak("Can't create $data->{FILE}.def: $!\n");
  96     print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
  97     print DEF "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n";
  98     print DEF "CODE LOADONCALL\n";
  99     print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
 100     print DEF "EXPORTS\n  ";
 101     print DEF join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
 102     print DEF join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
 103     if (%{$data->{IMPORTS}}) {
 104         print DEF "IMPORTS\n";
 105         my ($name, $exp);
 106         while (($name, $exp)= each %{$data->{IMPORTS}}) {
 107             print DEF "  $name=$exp\n";
 108         }
 109     }
 110     close DEF;
 111 }
 112
 113 sub _write_win32 {
 114     my($data) = @_;
 115
 116     require Config;
 117     if (not $data->{DLBASE}) {
 118         ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
 119         $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
 120     }
 121     rename "$data->{FILE}.def", "$data->{FILE}_def.old";
 122
 123     open(DEF,">$data->{FILE}.def")
 124         or croak("Can't create $data->{FILE}.def: $!\n");
 125     # put library name in quotes (it could be a keyword, like 'Alias')
 126     if ($Config::Config{'cc'} !~ /^gcc/i) {
 127       print DEF "LIBRARY \"$data->{DLBASE}\"\n";
 128     }
 129     print DEF "EXPORTS\n  ";
 130     my @syms;
 131     # Export public symbols both with and without underscores to
 132     # ensure compatibility between DLLs from different compilers
 133     # NOTE: DynaLoader itself only uses the names without underscores,
 134     # so this is only to cover the case when the extension DLL may be
 135     # linked to directly from C. GSAR 97-07-10
 136     if ($Config::Config{'cc'} =~ /^bcc/i) {
 137         for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
 138             push @syms, "_$_", "$_ = _$_";
 139         }
 140     }
 141     else {
 142         for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
 143             push @syms, "$_", "_$_ = $_";
 144         }
 145     }
 146     print DEF join("\n  ",@syms, "\n") if @syms;
 147     if (%{$data->{IMPORTS}}) {
 148         print DEF "IMPORTS\n";
 149         my ($name, $exp);
 150         while (($name, $exp)= each %{$data->{IMPORTS}}) {
 151             print DEF "  $name=$exp\n";
 152         }
 153     }
 154     close DEF;
 155 }
 156
 157
 158 sub _write_vms {
 159     my($data) = @_;
 160
 161     require Config; # a reminder for once we do $^O
 162     require ExtUtils::XSSymSet;
 163
 164     my($isvax) = $Config::Config{'archname'} =~ /VAX/i;
 165     my($set) = new ExtUtils::XSSymSet;
 166     my($sym);
 167
 168     rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
 169
 170     open(OPT,">$data->{FILE}.opt")
 171         or croak("Can't create $data->{FILE}.opt: $!\n");
 172
 173     # Options file declaring universal symbols
 174     # Used when linking shareable image for dynamic extension,
 175     # or when linking PerlShr into which we've added this package
 176     # as a static extension
 177     # We don't do anything to preserve order, so we won't relax
 178     # the GSMATCH criteria for a dynamic extension
 179
 180     print OPT "case_sensitive=yes\n"
 181         if $Config::Config{d_vms_case_sensitive_symbols};
 182     foreach $sym (@{$data->{FUNCLIST}}) {
 183         my $safe = $set->addsym($sym);
 184         if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
 185         else        { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
 186     }
 187     foreach $sym (@{$data->{DL_VARS}}) {
 188         my $safe = $set->addsym($sym);
 189         print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
 190         if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
 191         else        { print OPT "SYMBOL_VECTOR=($safe=DATA)\n"; }
 192     }
 193     close OPT;
 194
 195 }
 196
 197 1;
 198
 199 __END__
 200
 201 =head1 NAME
 202
 203 ExtUtils::Mksymlists - write linker options files for dynamic extension
 204
 205 =head1 SYNOPSIS
 206
 207     use ExtUtils::Mksymlists;
 208     Mksymlists({ NAME     => $name ,
 209                  DL_VARS  => [ $var1, $var2, $var3 ],
 210                  DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
 211                                $pkg2 => [ $func3 ] });
 212
 213 =head1 DESCRIPTION
 214
 215 C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
 216 during the creation of shared libraries for dynamic extensions.  It is
 217 normally called from a MakeMaker-generated Makefile when the extension
 218 is built.  The linker option file is generated by calling the function
 219 C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
 220 It takes one argument, a list of key-value pairs, in which the following
 221 keys are recognized:
 222
 223 =over 4
 224
 225 =item DLBASE
 226
 227 This item specifies the name by which the linker knows the
 228 extension, which may be different from the name of the
 229 extension itself (for instance, some linkers add an '_' to the
 230 name of the extension).  If it is not specified, it is derived
 231 from the NAME attribute.  It is presently used only by OS2 and Win32.
 232
 233 =item DL_FUNCS
 234
 235 This is identical to the DL_FUNCS attribute available via MakeMaker,
 236 from which it is usually taken.  Its value is a reference to an
 237 associative array, in which each key is the name of a package, and
 238 each value is an a reference to an array of function names which
 239 should be exported by the extension.  For instance, one might say
 240 C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
 241 Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
 242 function names should be identical to those in the XSUB code;
 243 C<Mksymlists> will alter the names written to the linker option
 244 file to match the changes made by F<xsubpp>.  In addition, if
 245 none of the functions in a list begin with the string B<boot_>,
 246 C<Mksymlists> will add a bootstrap function for that package,
 247 just as xsubpp does.  (If a B<boot_E<lt>pkgE<gt>> function is
 248 present in the list, it is passed through unchanged.)  If
 249 DL_FUNCS is not specified, it defaults to the bootstrap
 250 function for the extension specified in NAME.
 251
 252 =item DL_VARS
 253
 254 This is identical to the DL_VARS attribute available via MakeMaker,
 255 and, like DL_FUNCS, it is usually specified via MakeMaker.  Its
 256 value is a reference to an array of variable names which should
 257 be exported by the extension.
 258
 259 =item FILE
 260
 261 This key can be used to specify the name of the linker option file
 262 (minus the OS-specific extension), if for some reason you do not
 263 want to use the default value, which is the last word of the NAME
 264 attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
 265
 266 =item FUNCLIST
 267
 268 This provides an alternate means to specify function names to be
 269 exported from the extension.  Its value is a reference to an
 270 array of function names to be exported by the extension.  These
 271 names are passed through unaltered to the linker options file.
 272 Specifying a value for the FUNCLIST attribute suppresses automatic
 273 generation of the bootstrap function for the package. To still create
 274 the bootstrap name you have to specify the package name in the
 275 DL_FUNCS hash:
 276
 277     Mksymlists({ NAME     => $name ,
 278                  FUNCLIST => [ $func1, $func2 ],
 279                  DL_FUNCS => { $pkg => [] } });
 280
 281
 282 =item IMPORTS
 283
 284 This attribute is used to specify names to be imported into the
 285 extension. It is currently only used by OS/2 and Win32.
 286
 287 =item NAME
 288
 289 This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
 290 the linker option file will be produced.
 291
 292 =back
 293
 294 When calling C<Mksymlists>, one should always specify the NAME
 295 attribute.  In most cases, this is all that's necessary.  In
 296 the case of unusual extensions, however, the other attributes
 297 can be used to provide additional information to the linker.
 298
 299 =head1 AUTHOR
 300
 301 Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>>
 302
 303 =head1 REVISION
 304
 305 Last revised 14-Feb-1996, for Perl 5.002.