lib/ExtUtils/Mksymlists.pm

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