This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In POSIX, drastically simplify the wrappers for "unimplemented" functions.
authorAristotle Pagaltzis <pagaltzis@gmx.de>
Wed, 31 Aug 2011 12:59:57 +0000 (14:59 +0200)
committerNicholas Clark <nick@ccl4.org>
Thu, 1 Sep 2011 19:54:13 +0000 (21:54 +0200)
Replace all the subroutines that croak() with a data structure and 8 lines in
POSIX::AUTOLOAD().

[By Aristotle Pagaltzis, with some editing by the committer, and most of his
message changes applied as a previous commit to split apart improvements from
pure refactoring]

This commit eliminates the helper functions POSIX::refef() and
POSIX::unimpl(), which were not part of the documented API, not exported,
and not used in any code outside the core (that is visible to Google
codesearch).

ext/POSIX/lib/POSIX.pm
ext/POSIX/lib/POSIX.pod

index 05a474c..7899922 100644 (file)
@@ -18,15 +18,18 @@ use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
             S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
             S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
 
-# Grandfather old foo_h form to new :foo_h form
 my $loaded;
 
 sub import {
+    my $pkg = shift;
+
     load_imports() unless $loaded++;
-    my $this = shift;
-    my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
+
+    # Grandfather old foo_h form to new :foo_h form
+    s/^(?=\w+_h$)/:/ for my @list = @_;
+
     local $Exporter::ExportLevel = 1;
-    Exporter::import($this,@list);
+    Exporter::import($pkg,@list);
 }
 
 sub croak { require Carp;  goto &Carp::croak }
@@ -35,16 +38,109 @@ sub usage;
 
 XSLoader::load();
 
+my %replacement = (
+    atexit      => 'END {}',
+    atof        => undef,
+    atoi        => undef,
+    atol        => undef,
+    bsearch     => \'not supplied',
+    calloc      => undef,
+    clearerr    => 'IO::Handle::clearerr',
+    div         => '/, % and int',
+    execl       => undef,
+    execle      => undef,
+    execlp      => undef,
+    execv       => undef,
+    execve      => undef,
+    execvp      => undef,
+    fclose      => 'IO::Handle::close',
+    fdopen      => 'IO::Handle::new_from_fd',
+    feof        => 'IO::Handle::eof',
+    ferror      => 'IO::Handle::error',
+    fflush      => 'IO::Handle::flush',
+    fgetc       => 'IO::Handle::getc',
+    fgetpos     => 'IO::Seekable::getpos',
+    fgets       => 'IO::Handle::gets',
+    fileno      => 'IO::Handle::fileno',
+    fopen       => 'IO::File::open',
+    fprintf     => 'printf',
+    fputc       => 'print',
+    fputs       => 'print',
+    fread       => 'read',
+    free        => undef,
+    freopen     => 'open',
+    fscanf      => '<> and regular expressions',
+    fseek       => 'IO::Seekable::seek',
+    fsetpos     => 'IO::Seekable::setpos',
+    fsync       => 'IO::Handle::sync',
+    ftell       => 'IO::Seekable::tell',
+    fwrite      => 'print',
+    labs        => 'abs',
+    ldiv        => '/, % and int',
+    longjmp     => 'die',
+    malloc      => undef,
+    memchr      => 'index()',
+    memcmp      => 'eq',
+    memcpy      => '=',
+    memmove     => '=',
+    memset      => 'x',
+    offsetof    => undef,
+    putc        => 'print',
+    putchar     => 'print',
+    puts        => 'print',
+    qsort       => 'sort',
+    rand        => \'non-portable, use Perl\'s rand instead',
+    realloc     => undef,
+    scanf       => '<> and regular expressions',
+    setbuf      => 'IO::Handle::setbuf',
+    setjmp      => 'eval {}',
+    setvbuf     => 'IO::Handle::setvbuf',
+    siglongjmp  => 'die',
+    sigsetjmp   => 'eval {}',
+    srand       => \'not supplied, refer to Perl\'s srand documentation',
+    sscanf      => 'regular expressions',
+    strcat      => '.=',
+    strchr      => 'index()',
+    strcmp      => 'eq',
+    strcpy      => '=',
+    strcspn     => 'regular expressions',
+    strlen      => 'length',
+    strncat     => '.=',
+    strncmp     => 'eq',
+    strncpy     => '=',
+    strpbrk     => undef,
+    strrchr     => 'rindex()',
+    strspn      => undef,
+    strtok      => undef,
+    tmpfile     => 'IO::File::new_tmpfile',
+    ungetc      => 'IO::Handle::ungetc',
+    vfprintf    => undef,
+    vprintf     => undef,
+    vsprintf    => undef,
+);
+
+eval "sub $_;" for keys %replacement;
+
 sub AUTOLOAD {
     no warnings 'uninitialized';
-    if ($AUTOLOAD =~ /::(_?[a-z])/) {
-       # require AutoLoader;
+
+    my ($func) = ($AUTOLOAD =~ /.*::(.*)/);
+
+    if (exists $replacement{$func}) {
+       my $how = $replacement{$func};
+       croak "Unimplemented: POSIX::$func() is C-specific, stopped"
+           unless defined $how;
+       croak "Unimplemented: POSIX::$func() is $$how" if ref $how;
+       croak "Use method $how() instead" if $how =~ /::/;
+       croak "Unimplemented: POSIX::$func() is C-specific, use $how instead";
+    }
+
+    if ($func =~ /^_?[a-z]/) {
        $AutoLoader::AUTOLOAD = $AUTOLOAD;
        goto &AutoLoader::AUTOLOAD
     }
-    my $constname = $AUTOLOAD;
-    $constname =~ s/.*:://;
-    constant($constname);
+
+    constant($func);
 }
 
 package POSIX::SigAction;
@@ -77,17 +173,6 @@ sub usage {
     croak "Usage: POSIX::$mess";
 }
 
-sub redef {
-    my ($mess) = @_;
-    croak "Use method $mess instead";
-}
-
-sub unimpl {
-    my ($mess) = @_;
-    $mess =~ s/xxx//;
-    croak "Unimplemented: POSIX::$mess";
-}
-
 sub assert {
     usage "assert(expr)" if @_ != 1;
     if (!$_[0]) {
@@ -203,22 +288,6 @@ sub getpwuid {
     CORE::getpwuid($_[0]);
 }
 
-sub longjmp {
-    unimpl "longjmp() is C-specific, use die instead";
-}
-
-sub setjmp {
-    unimpl "setjmp() is C-specific, use eval {} instead";
-}
-
-sub siglongjmp {
-    unimpl "siglongjmp() is C-specific, use die instead";
-}
-
-sub sigsetjmp {
-    unimpl "sigsetjmp() is C-specific, use eval {} instead";
-}
-
 sub kill {
     usage "kill(pid, sig)" if @_ != 2;
     CORE::kill $_[1], $_[0];
@@ -229,98 +298,6 @@ sub raise {
     CORE::kill $_[0], $$;      # Is this good enough?
 }
 
-sub offsetof {
-    unimpl "offsetof() is C-specific, stopped";
-}
-
-sub clearerr {
-    redef "IO::Handle::clearerr()";
-}
-
-sub fclose {
-    redef "IO::Handle::close()";
-}
-
-sub fdopen {
-    redef "IO::Handle::new_from_fd()";
-}
-
-sub feof {
-    redef "IO::Handle::eof()";
-}
-
-sub fgetc {
-    redef "IO::Handle::getc()";
-}
-
-sub fgets {
-    redef "IO::Handle::gets()";
-}
-
-sub fileno {
-    redef "IO::Handle::fileno()";
-}
-
-sub fopen {
-    redef "IO::File::open()";
-}
-
-sub fprintf {
-    unimpl "fprintf() is C-specific, use printf instead";
-}
-
-sub fputc {
-    unimpl "fputc() is C-specific, use print instead";
-}
-
-sub fputs {
-    unimpl "fputs() is C-specific, use print instead";
-}
-
-sub fread {
-    unimpl "fread() is C-specific, use read instead";
-}
-
-sub freopen {
-    unimpl "freopen() is C-specific, use open instead";
-}
-
-sub fscanf {
-    unimpl "fscanf() is C-specific, use <> and regular expressions instead";
-}
-
-sub fseek {
-    redef "IO::Seekable::seek()";
-}
-
-sub fsync {
-    redef "IO::Handle::sync()";
-}
-
-sub ferror {
-    redef "IO::Handle::error()";
-}
-
-sub fflush {
-    redef "IO::Handle::flush()";
-}
-
-sub fgetpos {
-    redef "IO::Seekable::getpos()";
-}
-
-sub fsetpos {
-    redef "IO::Seekable::setpos()";
-}
-
-sub ftell {
-    redef "IO::Seekable::tell()";
-}
-
-sub fwrite {
-    unimpl "fwrite() is C-specific, use print instead";
-}
-
 sub getc {
     usage "getc(handle)" if @_ != 1;
     CORE::getc($_[0]);
@@ -346,18 +323,6 @@ sub printf {
     CORE::printf STDOUT @_;
 }
 
-sub putc {
-    unimpl "putc() is C-specific, use print instead";
-}
-
-sub putchar {
-    unimpl "putchar() is C-specific, use print instead";
-}
-
-sub puts {
-    unimpl "puts() is C-specific, use print instead";
-}
-
 sub remove {
     usage "remove(filename)" if @_ != 1;
     (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]);
@@ -373,202 +338,42 @@ sub rewind {
     CORE::seek($_[0],0,0);
 }
 
-sub scanf {
-    unimpl "scanf() is C-specific, use <> and regular expressions instead";
-}
-
 sub sprintf {
     usage "sprintf(pattern, args...)" if @_ == 0;
     CORE::sprintf(shift,@_);
 }
 
-sub sscanf {
-    unimpl "sscanf() is C-specific, use regular expressions instead";
-}
-
-sub tmpfile {
-    redef "IO::File::new_tmpfile()";
-}
-
-sub ungetc {
-    redef "IO::Handle::ungetc()";
-}
-
-sub vfprintf {
-    unimpl "vfprintf() is C-specific, stopped";
-}
-
-sub vprintf {
-    unimpl "vprintf() is C-specific, stopped";
-}
-
-sub vsprintf {
-    unimpl "vsprintf() is C-specific, stopped";
-}
-
 sub abs {
     usage "abs(x)" if @_ != 1;
     CORE::abs($_[0]);
 }
 
-sub atexit {
-    unimpl "atexit() is C-specific, use END {} instead";
-}
-
-sub atof {
-    unimpl "atof() is C-specific, stopped";
-}
-
-sub atoi {
-    unimpl "atoi() is C-specific, stopped";
-}
-
-sub atol {
-    unimpl "atol() is C-specific, stopped";
-}
-
-sub bsearch {
-    unimpl "bsearch() is not supplied";
-}
-
-sub calloc {
-    unimpl "calloc() is C-specific, stopped";
-}
-
-sub div {
-    unimpl "div() is C-specific, use /, % and int instead";
-}
-
 sub exit {
     usage "exit(status)" if @_ != 1;
     CORE::exit($_[0]);
 }
 
-sub free {
-    unimpl "free() is C-specific, stopped";
-}
-
 sub getenv {
     usage "getenv(name)" if @_ != 1;
     $ENV{$_[0]};
 }
 
-sub labs {
-    unimpl "labs() is C-specific, use abs instead";
-}
-
-sub ldiv {
-    unimpl "ldiv() is C-specific, use /, % and int instead";
-}
-
-sub malloc {
-    unimpl "malloc() is C-specific, stopped";
-}
-
-sub qsort {
-    unimpl "qsort() is C-specific, use sort instead";
-}
-
-sub rand {
-    unimpl "rand() is non-portable, use Perl's rand instead";
-}
-
-sub realloc {
-    unimpl "realloc() is C-specific, stopped";
-}
-
-sub srand {
-    unimpl "srand() is not supplied, refer to Perl's srand documentation";
-}
-
 sub system {
     usage "system(command)" if @_ != 1;
     CORE::system($_[0]);
 }
 
-sub memchr {
-    unimpl "memchr() is C-specific, use index() instead";
-}
-
-sub memcmp {
-    unimpl "memcmp() is C-specific, use eq instead";
-}
-
-sub memcpy {
-    unimpl "memcpy() is C-specific, use = instead";
-}
-
-sub memmove {
-    unimpl "memmove() is C-specific, use = instead";
-}
-
-sub memset {
-    unimpl "memset() is C-specific, use x instead";
-}
-
-sub strcat {
-    unimpl "strcat() is C-specific, use .= instead";
-}
-
-sub strchr {
-    unimpl "strchr() is C-specific, use index() instead";
-}
-
-sub strcmp {
-    unimpl "strcmp() is C-specific, use eq instead";
-}
-
-sub strcpy {
-    unimpl "strcpy() is C-specific, use = instead";
-}
-
-sub strcspn {
-    unimpl "strcspn() is C-specific, use regular expressions instead";
-}
-
 sub strerror {
     usage "strerror(errno)" if @_ != 1;
     local $! = $_[0];
     $! . "";
 }
 
-sub strlen {
-    unimpl "strlen() is C-specific, use length instead";
-}
-
-sub strncat {
-    unimpl "strncat() is C-specific, use .= instead";
-}
-
-sub strncmp {
-    unimpl "strncmp() is C-specific, use eq instead";
-}
-
-sub strncpy {
-    unimpl "strncpy() is C-specific, use = instead";
-}
-
-sub strpbrk {
-    unimpl "strpbrk() is C-specific, stopped";
-}
-
-sub strrchr {
-    unimpl "strrchr() is C-specific, use rindex() instead";
-}
-
-sub strspn {
-    unimpl "strspn() is C-specific, stopped";
-}
-
 sub strstr {
     usage "strstr(big, little)" if @_ != 2;
     CORE::index($_[0], $_[1]);
 }
 
-sub strtok {
-    unimpl "strtok() is C-specific, stopped";
-}
-
 sub chmod {
     usage "chmod(mode, filename)" if @_ != 2;
     CORE::chmod($_[0], $_[1]);
@@ -638,30 +443,6 @@ sub chown {
     CORE::chown($_[0], $_[1], $_[2]);
 }
 
-sub execl {
-    unimpl "execl() is C-specific, stopped";
-}
-
-sub execle {
-    unimpl "execle() is C-specific, stopped";
-}
-
-sub execlp {
-    unimpl "execlp() is C-specific, stopped";
-}
-
-sub execv {
-    unimpl "execv() is C-specific, stopped";
-}
-
-sub execve {
-    unimpl "execve() is C-specific, stopped";
-}
-
-sub execvp {
-    unimpl "execvp() is C-specific, stopped";
-}
-
 sub fork {
     usage "fork()" if @_ != 0;
     CORE::fork;
@@ -728,14 +509,6 @@ sub rmdir {
     CORE::rmdir($_[0]);
 }
 
-sub setbuf {
-    redef "IO::Handle::setbuf()";
-}
-
-sub setvbuf {
-    redef "IO::Handle::setvbuf()";
-}
-
 sub sleep {
     usage "sleep(seconds)" if @_ != 1;
     $_[0] - CORE::sleep($_[0]);
@@ -899,7 +672,6 @@ our %EXPORT_TAGS = (
                setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
 
     utime_h => [],
-
 );
 
 # Exporter::export_tags();
@@ -984,7 +756,6 @@ sub safe    { $_[0]->{SAFE}    = $_[1] if @_ > 1; $_[0]->{SAFE} };
 
 package POSIX::SigRt;
 
-
 sub _init {
     $_SIGRTMIN = &POSIX::SIGRTMIN;
     $_SIGRTMAX = &POSIX::SIGRTMAX;
index 0327d05..c2ca1c9 100644 (file)
@@ -39,13 +39,6 @@ and other miscellaneous objects.  The remaining sections list various
 constants and macros in an organization which roughly follows IEEE Std
 1003.1b-1993.
 
-=head1 NOTE
-
-The POSIX module is probably the most complex Perl module supplied with
-the standard distribution.  It incorporates autoloading, namespace games,
-and dynamic loading of code that's in Perl, C, or both.  It's a great
-source of wisdom.
-
 =head1 CAVEATS
 
 A few functions are not implemented because they are C specific.  If you