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