[PATCH 1/3] get rid of huge swathes of repetitive code in POSIX.pm

---
 ext/POSIX/lib/POSIX.pm  |  437 +++++++++++------------------------------------
 ext/POSIX/lib/POSIX.pod |    7 -
 ext/POSIX/t/posix.t     |    2 +-
 3 files changed, 104 insertions(+), 342 deletions(-)

diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index 990b73b..1ef4bbe 100644
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -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,107 @@ 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        => \'is 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 (my $how = $replacement{$func}) {
+	croak "Unimplemented: POSIX::$func() is C-specific, stopped" if not defined $how;
+	croak "Unimplemented: POSIX::$func() $$_" if ref $how;
+	croak "Use method $_() instead of POSIX::$func()" if $how =~ /->/;
+	croak "Unimplemented: POSIX::$func() is C-specific, use $_ instead";
+    }
+
+    if ($func =~ /^_?[a-z]/) {
 	$AutoLoader::AUTOLOAD = $AUTOLOAD;
 	goto &AutoLoader::AUTOLOAD
     }
-    my $constname = $AUTOLOAD;
-    $constname =~ s/.*:://;
-    constant($constname);
+
+    constant($func);
 }
 
 package POSIX::SigAction;
@@ -76,17 +170,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]) {
@@ -202,22 +285,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];
@@ -228,98 +295,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]);
@@ -345,18 +320,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]);
@@ -372,202 +335,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";
-}
-
-sub vprintf {
-    unimpl "vprintf() is C-specific";
-}
-
-sub vsprintf {
-    unimpl "vsprintf() is C-specific";
-}
-
 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() 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()";
-}
-
 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]);
@@ -637,30 +440,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;
@@ -727,14 +506,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]);
@@ -898,7 +669,6 @@ sub load_imports {
 		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
 
     utime_h =>	[],
-
 );
 
 # Exporter::export_tags();
@@ -983,7 +753,6 @@ sub safe    { $_[0]->{SAFE}    = $_[1] if @_ > 1; $_[0]->{SAFE} };
 
 package POSIX::SigRt;
 
-
 sub _init {
     $_SIGRTMIN = &POSIX::SIGRTMIN;
     $_SIGRTMAX = &POSIX::SIGRTMAX;
diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod
index 9df0cde..d392131 100644
--- a/ext/POSIX/lib/POSIX.pod
+++ b/ext/POSIX/lib/POSIX.pod
@@ -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
diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t
index 32382e8..8bc87ee 100644
--- a/ext/POSIX/t/posix.t
+++ b/ext/POSIX/t/posix.t
@@ -261,7 +261,7 @@ like ($@, qr/^Unimplemented: POSIX::offsetof\(\) is C-specific/,
 # Check reimplemented.
 $result = eval {POSIX::fgets};
 is ($result, undef, "fgets should fail");
-like ($@, qr/^Use method IO::Handle::gets\(\) instead/,
+like ($@, qr/^Use method IO::Handle->gets\(\) instead/,
       "check its redef message");
 
 # Simplistic tests for the isXXX() functions (bug #16799)
-- 
1.7.3

• Time to update POSIX.pm? by Mark Overmeer
• Re: Time to update POSIX.pm? by Mark Overmeer
• setuid and serious trouble (Re: Time to update POSIX.pm?) by Mark Overmeer
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Leon Timmermans
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Leon Timmermans
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Mark Overmeer
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Leon Timmermans
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Mark Overmeer
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Abigail
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Tom Christiansen
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Mark Overmeer
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Tom Christiansen
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Tom Christiansen
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Leon Timmermans
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Mark Overmeer
• Re: setuid and serious trouble (Re: Time to update POSIX.pm?) by Leon Timmermans
• Re: Time to update POSIX.pm? by Tom Christiansen
• Re: Time to update POSIX.pm? by Mark Overmeer
• Re: Time to update POSIX.pm? by Karl Williamson
• Re: Time to update POSIX.pm? by Tom Christiansen
• Re: Time to update POSIX.pm? by Karl Williamson
• Re: Time to update POSIX.pm? by Eric Brine
• Re: Time to update POSIX.pm? by Mark Overmeer
• Re: Time to update POSIX.pm? by Eric Brine
• Re: Time to update POSIX.pm? by Eric Brine
• Re: Time to update POSIX.pm? by Jesse Vincent
• Re: Time to update POSIX.pm? by Abigail
• Re: Time to update POSIX.pm? by Mark Overmeer
• Re: Time to update POSIX.pm? by Jesse Vincent
• Re: Time to update POSIX.pm? by Eirik Berg Hanssen
• Re: Time to update POSIX.pm? by Nicholas Clark
• RE: Time to update POSIX.pm? by Jan Dubois
• Re: Time to update POSIX.pm? by Tom Christiansen
• Re: Time to update POSIX.pm? by Jesse Vincent
• Re: Time to update POSIX.pm? by Aristotle Pagaltzis
• [PATCH 3/3] use custom compilation deferral scheme in POSIX.pm by Aristotle Pagaltzis
• [PATCH 2/3] modernise package variable style by Aristotle Pagaltzis
• Re: [PATCH 2/3] modernise package variable style by Eric Brine
• Re: [PATCH 2/3] modernise package variable style by Aristotle Pagaltzis
• Re: [PATCH 2/3] modernise package variable style by Eric Brine
• Re: [PATCH 2/3] modernise package variable style by Eric Brine
• Re: [PATCH 2/3] modernise package variable style by Tom Christiansen
• [PATCH 1/3] get rid of huge swathes of repetitive code in POSIX.pm by Aristotle Pagaltzis
• how to tersely name instance methods in classes (was Re: [PATCH 1/3]get rid of huge swathes of repetitive code in) POSIX.pm by Nicholas Clark
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code in POSIX.pm by ilmari
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code inPOSIX.pm by Aristotle Pagaltzis
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code in POSIX.pm by John Imrie
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code inPOSIX.pm by Aristotle Pagaltzis
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code in POSIX.pm by John Imrie
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code in POSIX.pm by Eirik Berg Hanssen
• Re: [PATCH 1/3] get rid of huge swathes of repetitive code inPOSIX.pm by Aristotle Pagaltzis