view release on metacpan or  search on metacpan

ext/POSIX/lib/POSIX.pm  view on Meta::CPAN

    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',
    tmpnam      => 'use File::Temp',
    ungetc      => 'IO::Handle::ungetc',
    vfprintf    => undef,
    vprintf     => undef,
    vsprintf    => undef,
);

my %reimpl = (
    abs       => 'x => CORE::abs($_[0])',
    alarm     => 'seconds => CORE::alarm($_[0])',
    assert    => 'expr => croak "Assertion failed" if !$_[0]',
    atan2     => 'x, y => CORE::atan2($_[0], $_[1])',
    chdir     => 'directory => CORE::chdir($_[0])',
    chmod     => 'mode, filename => CORE::chmod($_[0], $_[1])',
    chown     => 'uid, gid, filename => CORE::chown($_[0], $_[1], $_[2])',
    closedir  => 'dirhandle => CORE::closedir($_[0])',
    cos       => 'x => CORE::cos($_[0])',
    creat     => 'filename, mode => &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1])',
    errno     => '$! + 0',
    exit      => 'status => CORE::exit($_[0])',
    exp       => 'x => CORE::exp($_[0])',
    fabs      => 'x => CORE::abs($_[0])',
    fcntl     => 'filehandle, cmd, arg => CORE::fcntl($_[0], $_[1], $_[2])',
    fork      => 'CORE::fork',
    fstat     => 'fd => CORE::open my $dup, "<&", $_[0]; CORE::stat($dup)', # Gross.
    getc      => 'handle => CORE::getc($_[0])',
    getchar   => 'CORE::getc(STDIN)',
    getegid   => '$) + 0',
    getenv    => 'name => $ENV{$_[0]}',
    geteuid   => '$> + 0',
    getgid    => '$( + 0',
    getgrgid  => 'gid => CORE::getgrgid($_[0])',
    getgrnam  => 'name => CORE::getgrnam($_[0])',
    getgroups => 'my %seen; grep !$seen{$_}++, split " ", $)',
    getlogin  => 'CORE::getlogin()',
    getpgrp   => 'CORE::getpgrp',
    getpid    => '$$',
    getppid   => 'CORE::getppid',
    getpwnam  => 'name => CORE::getpwnam($_[0])',
    getpwuid  => 'uid => CORE::getpwuid($_[0])',
    gets      => 'scalar <STDIN>',
    getuid    => '$<',
    gmtime    => 'time => CORE::gmtime($_[0])',
    isatty    => 'filehandle => -t $_[0]',
    kill      => 'pid, sig => CORE::kill $_[1], $_[0]',
    link      => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
    localtime => 'time => CORE::localtime($_[0])',
    log       => 'x => CORE::log($_[0])',
    mkdir     => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
    opendir   => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
    pow       => 'x, exponent => $_[0] ** $_[1]',
    raise     => 'sig => CORE::kill $_[0], $$;	# Is this good enough',
    readdir   => 'dirhandle => CORE::readdir($_[0])',
    remove    => 'filename => (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0])',
    rename    => 'oldfilename, newfilename => CORE::rename($_[0], $_[1])',
    rewind    => 'filehandle => CORE::seek($_[0],0,0)',
    rewinddir => 'dirhandle => CORE::rewinddir($_[0])',
    rmdir     => 'directoryname => CORE::rmdir($_[0])',
    sin       => 'x => CORE::sin($_[0])',
    sqrt      => 'x => CORE::sqrt($_[0])',
    stat      => 'filename => CORE::stat($_[0])',
    strerror  => 'errno => BEGIN { local $!; require locale; locale->import} my $e = $_[0] + 0; local $!; $! = $e; "$!"',
    strstr    => 'big, little => CORE::index($_[0], $_[1])',
    system    => 'command => CORE::system($_[0])',
    time      => 'CORE::time',
    umask     => 'mask => CORE::umask($_[0])',
    unlink    => 'filename => CORE::unlink($_[0])',
    utime     => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])',
    wait      => 'CORE::wait()',
    waitpid   => 'pid, options => CORE::waitpid($_[0], $_[1])',
);

sub import {
    my $pkg = shift;

    load_imports() unless $loaded++;

    # Rewrite legacy foo_h form to new :foo_h form
    s/^(?=\w+_h$)/:/ for my @list = @_;

    my @unimpl = sort grep { exists $replacement{$_} } @list;
    if (@unimpl) {
      for my $u (@unimpl) {
        warn "Unimplemented: POSIX::$u(): ", unimplemented_message($u);
      }
      croak(sprintf("Unimplemented: %s",
                    join(" ", map { "POSIX::$_()" } @unimpl)));
    }

    local $Exporter::ExportLevel = 1;
    Exporter::import($pkg,@list);
}

eval join ';', map "sub $_", keys %replacement, keys %reimpl;

sub unimplemented_message {
  my $func = shift;
  my $how = $replacement{$func};
  return "C-specific, stopped" unless defined $how;
  return "$$how" if ref $how;