1use ExtUtils::MakeMaker; 2use Config; 3use strict; 4 5our $VERSION = "1.37"; 6 7my %err = (); 8 9my $IsMSWin32 = $^O eq 'MSWin32'; 10 11unlink "Errno.pm" if -f "Errno.pm"; 12unlink "Errno.tmp" if -f "Errno.tmp"; 13open OUT, '>', 'Errno.tmp' or die "Cannot open Errno.tmp: $!"; 14select OUT; 15my $file; 16my @files = get_files(); 17if ($Config{gccversion} ne '' && $^O eq 'MSWin32') { 18 # MinGW complains "warning: #pragma system_header ignored outside include 19 # file" if the header files are processed individually, so include them 20 # all in .c file and process that instead. 21 open INCS, '>', 'includes.c' or 22 die "Cannot open includes.c"; 23 foreach $file (@files) { 24 next if $file eq 'errno.c'; 25 next unless -f $file; 26 print INCS qq[#include "$file"\n]; 27 } 28 close INCS; 29 process_file('includes.c'); 30 unlink 'includes.c'; 31} 32else { 33 foreach $file (@files) { 34 process_file($file); 35 } 36} 37write_errno_pm(); 38unlink "errno.c" if -f "errno.c"; 39close OUT or die "Error closing Errno.tmp: $!"; 40select STDOUT; 41rename "Errno.tmp", "Errno.pm" or die "Cannot rename Errno.tmp to Errno.pm: $!"; 42 43sub process_file { 44 my($file) = @_; 45 46 # for win32 perl under cygwin, we need to get a windows pathname 47 if ($^O eq 'MSWin32' && $Config{cc} =~ /\B-mno-cygwin\b/ && 48 defined($file) && !-f $file) { 49 chomp($file = `cygpath -w "$file"`); 50 } 51 52 return unless defined $file and -f $file; 53# warn "Processing $file\n"; 54 55 local *FH; 56 if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) { 57 unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) { 58 warn "Cannot open '$file'"; 59 return; 60 } 61 } elsif ($Config{gccversion} ne '' && $^O ne 'darwin' ) { 62 # With the -dM option, gcc outputs every #define it finds 63 unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) { 64 warn "Cannot open '$file'"; 65 return; 66 } 67 } else { 68 unless(open(FH, '<', $file)) { 69 # This file could be a temporary file created by cppstdin 70 # so only warn under -w, and return 71 warn "Cannot open '$file'" if $^W; 72 return; 73 } 74 } 75 76 my $pat; 77 if ($IsMSWin32) { 78 $pat = '^\s*#\s*define\s+((?:WSA)?E\w+)\s+'; 79 } 80 else { 81 $pat = '^\s*#\s*define\s+(E\w+)\s+'; 82 } 83 while(<FH>) { 84 $err{$1} = 1 85 if /$pat/; 86 } 87 88 close(FH); 89} 90 91my $cppstdin; 92 93sub default_cpp { 94 unless (defined $cppstdin) { 95 use File::Spec; 96 $cppstdin = $Config{cppstdin}; 97 my $upup_cppstdin = File::Spec->catfile(File::Spec->updir, 98 File::Spec->updir, 99 "cppstdin"); 100 my $cppstdin_is_wrapper = 101 ($cppstdin eq 'cppstdin' 102 and -f $upup_cppstdin 103 and -x $upup_cppstdin); 104 $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper; 105 } 106 return "$cppstdin $Config{cppflags} $Config{cppminus}"; 107} 108 109sub get_files { 110 my @file; 111 # When cross-compiling we may store a path for gcc's "sysroot" option: 112 my $sysroot = $Config{sysroot} || ''; 113 my $linux_errno_h; 114 if ($^O eq 'linux') { 115 # Some Linuxes have weird errno.hs which generate 116 # no #file or #line directives 117 ($linux_errno_h) = grep { -e $_ } map { "$_/errno.h" } 118 "$sysroot/usr/include", "$sysroot/usr/local/include", 119 split / / => $Config{locincpth}; 120 } 121 122 # VMS keeps its include files in system libraries 123 if ($^O eq 'VMS') { 124 push(@file, 'Sys$Library:DECC$RTLDEF.TLB'); 125 } elsif ($^O eq 'os390') { 126 # OS/390 C compiler doesn't generate #file or #line directives 127 # and it does not tag the header as 1047 (EBCDIC), so make a local 128 # copy and tag it 129 my $cp = `cp /usr/include/errno.h ./errno.h`; 130 my $chtag = `chtag -t -cIBM-1047 ./errno.h`; 131 push(@file, './errno.h'); 132 } elsif ($Config{archname} eq 'arm-riscos') { 133 # Watch out for cross compiling for RISC OS 134 my $dep = `echo "#include <errno.h>" | gcc -E -M -`; 135 if ($dep =~ /(\S+errno\.h)/) { 136 push(@file, $1); 137 } 138 } elsif ($^O eq 'linux' && 139 $Config{gccversion} ne '' && 140 $Config{gccversion} !~ /intel/i && 141 # might be using, say, Intel's icc 142 $linux_errno_h 143 ) { 144 push(@file, $linux_errno_h); 145 } elsif ($^O eq 'haiku') { 146 # hidden in a special place 147 push(@file, '/boot/system/develop/headers/posix/errno.h'); 148 149 } elsif ($^O eq 'vos') { 150 # avoid problem where cpp returns non-POSIX pathnames 151 push(@file, '/system/include_library/errno.h'); 152 } else { 153 open(CPPI, '>', 'errno.c') or 154 die "Cannot open errno.c"; 155 156 print CPPI "#include <errno.h>\n"; 157 if ($IsMSWin32) { 158 print CPPI qq[#include "../../win32/include/sys/errno2.h"\n]; 159 } 160 161 close(CPPI); 162 163 # invoke CPP and read the output 164 if ($IsMSWin32) { 165 open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or 166 die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; 167 } else { 168 my $cpp = default_cpp(); 169 open(CPPO,"$cpp < errno.c |") or 170 die "Cannot exec $cpp"; 171 } 172 173 my $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"'; 174 while(<CPPO>) { 175 if ($^O eq 'os2' or $IsMSWin32) { 176 if (/$pat/o) { 177 my $f = $1; 178 $f =~ s,\\\\,/,g; 179 push(@file, $f); 180 } 181 } 182 else { 183 push(@file, $1) if /$pat/o; 184 } 185 } 186 close(CPPO); 187 } 188 return uniq(@file); 189} 190 191# 192# 193sub uniq 194{ 195 # At this point List::Util::uniq appears not to be usable so 196 # roll our own. 197 # 198 # Returns a list with unique values, while keeping the order 199 # 200 return do { my %seen; grep { !$seen{$_}++ } @_ }; 201} 202 203sub write_errno_pm { 204 my $err; 205 206 # quick sanity check 207 208 die "No error definitions found" unless keys %err; 209 210 # create the CPP input 211 212 open(CPPI, '>', 'errno.c') or 213 die "Cannot open errno.c"; 214 215 print CPPI "#include <errno.h>\n"; 216 217 if ($IsMSWin32) { 218 print CPPI qq[#include "../../win32/include/sys/errno2.h"\n]; 219 } 220 221 foreach $err (keys %err) { 222 print CPPI '"',$err,'" [[',$err,']]',"\n"; 223 } 224 225 close(CPPI); 226 227 { # BeOS (support now removed) did not enter this block 228 # invoke CPP and read the output 229 230 my $inhibit_linemarkers = ''; 231 if ($Config{gccversion} =~ /\A(\d+)\./ and $1 >= 5) { 232 # GCC 5.0 interleaves expanded macros with line numbers breaking 233 # each line into multiple lines. RT#123784 234 $inhibit_linemarkers = ' -P'; 235 } 236 237 if ($^O eq 'VMS') { 238 my $cpp = "$Config{cppstdin} $Config{cppflags}" . 239 $inhibit_linemarkers . " $Config{cppminus}"; 240 $cpp =~ s/sys\$input//i; 241 open(CPPO,"$cpp errno.c |") or 242 die "Cannot exec $Config{cppstdin}"; 243 } elsif ($IsMSWin32) { 244 my $cpp = "$Config{cpprun} $Config{cppflags}" . 245 $inhibit_linemarkers; 246 open(CPPO,"$cpp errno.c |") or 247 die "Cannot run '$cpp errno.c'"; 248 } else { 249 my $cpp = default_cpp() . $inhibit_linemarkers; 250 open(CPPO,"$cpp < errno.c |") 251 or die "Cannot exec $cpp"; 252 } 253 254 %err = (); 255 256 while(<CPPO>) { 257 my($name,$expr); 258 next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; 259 next if $name eq $expr; 260 $expr =~ s/\(?\(\s*[a-z_]\w*\s*\)\(?([^\)]+)\)?\)?/$1/i; # ((type)0xcafebabe) et alia 261 $expr =~ s/\b((?:0x)?[0-9a-f]+)[LU]+\b/$1/gi; # 2147483647L et alia 262 next if $expr =~ m/\b[a-z_]\w*\b/i; # skip expressions containing function names etc 263 if($expr =~ m/^0[xX]/) { 264 $err{$name} = hex $expr; 265 } 266 else { 267 $err{$name} = eval $expr; 268 } 269 delete $err{$name} unless defined $err{$name}; 270 } 271 close(CPPO); 272 } 273 274 # escape $Config{'archname'} 275 my $archname = $Config{'archname'}; 276 $archname =~ s/([@%\$])/\\$1/g; 277 278 # Write Errno.pm 279 280 print <<"EDQ"; 281# -*- buffer-read-only: t -*- 282# 283# This file is auto-generated by ext/Errno/Errno_pm.PL. 284# ***ANY*** changes here will be lost. 285# 286 287package Errno; 288use Exporter 'import'; 289use strict; 290 291EDQ 292 293 # Errno only needs Config to make sure it hasn't changed platforms. 294 # If someone set $ENV{PERL_BUILD_EXPAND_CONFIG_VARS} at build time, 295 # they've already declared perl doesn't need to worry about this risk. 296 if(!$ENV{'PERL_BUILD_EXPAND_CONFIG_VARS'}) { 297 print <<"CONFIG_CHECK_END"; 298use Config; 299"\$Config{'archname'}-\$Config{'osvers'}" eq 300"$archname-$Config{'osvers'}" or 301 die "Errno architecture ($archname-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})"; 302 303CONFIG_CHECK_END 304} 305 306 print <<"EDQ"; 307our \$VERSION = "$VERSION"; 308\$VERSION = eval \$VERSION; 309 310my %err; 311 312BEGIN { 313 %err = ( 314EDQ 315 316 my @err = sort { $err{$a} <=> $err{$b} || $a cmp $b } 317 grep { $err{$_} =~ /-?\d+$/ } keys %err; 318 319 foreach $err (@err) { 320 print "\t$err => $err{$err},\n"; 321 } 322 323print <<'ESQ'; 324 ); 325 # Generate proxy constant subroutines for all the values. 326 # Well, almost all the values. Unfortunately we can't assume that at this 327 # point that our symbol table is empty, as code such as if the parser has 328 # seen code such as C<exists &Errno::EINVAL>, it will have created the 329 # typeglob. 330 # Doing this before defining @EXPORT_OK etc means that even if a platform is 331 # crazy enough to define EXPORT_OK as an error constant, everything will 332 # still work, because the parser will upgrade the PCS to a real typeglob. 333 # We rely on the subroutine definitions below to update the internal caches. 334 # Don't use %each, as we don't want a copy of the value. 335 foreach my $name (keys %err) { 336 if ($Errno::{$name}) { 337 # We expect this to be reached fairly rarely, so take an approach 338 # which uses the least compile time effort in the common case: 339 eval "sub $name() { $err{$name} }; 1" or die $@; 340 } else { 341 $Errno::{$name} = \$err{$name}; 342 } 343 } 344} 345 346our @EXPORT_OK = keys %err; 347 348our %EXPORT_TAGS = ( 349 POSIX => [qw( 350ESQ 351 352 my $k = join(" ", grep { exists $err{$_} } 353 qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT 354 EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED 355 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT 356 EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS 357 EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK 358 EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH 359 ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM 360 ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR 361 ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM 362 EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE 363 ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT 364 ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY 365 EUSERS EWOULDBLOCK EXDEV)); 366 367 $k =~ s/(.{50,70})\s/$1\n\t/g; 368 print "\t",$k,"\n )],\n"; 369 370 if ($IsMSWin32) { 371 print " WINSOCK => [qw(\n"; 372 $k = join(" ", grep { /^WSAE/ } sort keys %err); 373 $k =~ s/(.{50,70})\s/$1\n\t/g; 374 print "\t",$k,"\n )],\n"; 375 } 376 377 print ");\n\n"; 378 379 print <<'ESQ'; 380sub TIEHASH { bless \%err } 381 382sub FETCH { 383 my (undef, $errname) = @_; 384 return "" unless exists $err{$errname}; 385 my $errno = $err{$errname}; 386 return $errno == $! ? $errno : 0; 387} 388 389sub STORE { 390 require Carp; 391 Carp::confess("ERRNO hash is read only!"); 392} 393 394# This is the true return value 395*CLEAR = *DELETE = \*STORE; # Typeglob aliasing uses less space 396 397sub NEXTKEY { 398 each %err; 399} 400 401sub FIRSTKEY { 402 my $s = scalar keys %err; # initialize iterator 403 each %err; 404} 405 406sub EXISTS { 407 my (undef, $errname) = @_; 408 exists $err{$errname}; 409} 410 411sub _tie_it { 412 tie %{$_[0]}, __PACKAGE__; 413} 414 415__END__ 416 417=head1 NAME 418 419Errno - System errno constants 420 421=head1 SYNOPSIS 422 423 use Errno qw(EINTR EIO :POSIX); 424 425=head1 DESCRIPTION 426 427C<Errno> defines and conditionally exports all the error constants 428defined in your system F<errno.h> include file. It has a single export 429tag, C<:POSIX>, which will export all POSIX defined error numbers. 430 431On Windows, C<Errno> also defines and conditionally exports all the 432Winsock error constants defined in your system F<WinError.h> include 433file. These are included in a second export tag, C<:WINSOCK>. 434 435C<Errno> also makes C<%!> magic such that each element of C<%!> has a 436non-zero value only if C<$!> is set to that value. For example: 437 438 my $fh; 439 unless (open($fh, "<", "/fangorn/spouse")) { 440 if ($!{ENOENT}) { 441 warn "Get a wife!\n"; 442 } else { 443 warn "This path is barred: $!"; 444 } 445 } 446 447If a specified constant C<EFOO> does not exist on the system, C<$!{EFOO}> 448returns C<"">. You may use C<exists $!{EFOO}> to check whether the 449constant is available on the system. 450 451Perl automatically loads C<Errno> the first time you use C<%!>, so you don't 452need an explicit C<use>. 453 454=head1 CAVEATS 455 456Importing a particular constant may not be very portable, because the 457import will fail on platforms that do not have that constant. A more 458portable way to set C<$!> to a valid value is to use: 459 460 if (exists &Errno::EFOO) { 461 $! = &Errno::EFOO; 462 } 463 464=head1 AUTHOR 465 466Graham Barr <gbarr@pobox.com> 467 468=head1 COPYRIGHT 469 470Copyright (c) 1997-8 Graham Barr. All rights reserved. 471This program is free software; you can redistribute it and/or modify it 472under the same terms as Perl itself. 473 474=cut 475 476# ex: set ro: 477ESQ 478 479} 480