posix.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

package POSIX;
use strict;
use warnings;

our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();

our $VERSION = "1.13";

use AutoLoader;

use XSLoader ();

use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
	     F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
	     O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
	     O_WRONLY);

# Grandfather old foo_h form to new :foo_h form
my $loaded;

sub import {
    load_imports() unless $loaded++;
    my $this = shift;
    my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
    local $Exporter::ExportLevel = 1;
    Exporter::import($this,@list);
}

sub croak { require Carp;  goto &Carp::croak }
# declare usage to assist AutoLoad
sub usage;

XSLoader::load 'POSIX', $VERSION;

my %NON_CONSTS = (map {($_,1)}
                  qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS
                     WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));

sub AUTOLOAD {
    no strict;
    no warnings 'uninitialized';
    if ($AUTOLOAD =~ /::(_?[a-z])/) {
	# require AutoLoader;
	$AutoLoader::AUTOLOAD = $AUTOLOAD;
	goto &AutoLoader::AUTOLOAD
    }
    local $! = 0;
    my $constname = $AUTOLOAD;
    $constname =~ s/.*:://;
    if ($NON_CONSTS{$constname}) {
        my ($val, $error) = &int_macro_int($constname, $_[0]);
        croak $error if $error;
        *$AUTOLOAD = sub { &int_macro_int($constname, $_[0]) };
    } else {
        my ($error, $val) = constant($constname);
        croak $error if $error;
	*$AUTOLOAD = sub { $val };
    }

    goto &$AUTOLOAD;
}

package POSIX::SigAction;

use AutoLoader 'AUTOLOAD';

package POSIX::SigRt;

use AutoLoader 'AUTOLOAD';

use Tie::Hash;

use vars qw($SIGACTION_FLAGS $_SIGRTMIN $_SIGRTMAX $_sigrtn @ISA);
@POSIX::SigRt::ISA = qw(Tie::StdHash);

$SIGACTION_FLAGS = 0;

tie %POSIX::SIGRT, 'POSIX::SigRt';

sub DESTROY {};

package POSIX;

1;
__END__

sub usage {
    my ($mess) = @_;
    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]) {
	croak "Assertion failed";
    }
}

sub tolower {
    usage "tolower(string)" if @_ != 1;
    lc($_[0]);
}

sub toupper {
    usage "toupper(string)" if @_ != 1;
    uc($_[0]);
}

sub closedir {
    usage "closedir(dirhandle)" if @_ != 1;
    CORE::closedir($_[0]);
}

sub opendir {
    usage "opendir(directory)" if @_ != 1;
    my $dirhandle;
    CORE::opendir($dirhandle, $_[0])
	? $dirhandle
	: undef;
}

sub readdir {
    usage "readdir(dirhandle)" if @_ != 1;
    CORE::readdir($_[0]);
}

sub rewinddir {
    usage "rewinddir(dirhandle)" if @_ != 1;
    CORE::rewinddir($_[0]);
}

sub errno {
    usage "errno()" if @_ != 0;
    $! + 0;
}

sub creat {
    usage "creat(filename, mode)" if @_ != 2;
    &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
}

sub fcntl {
    usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
    CORE::fcntl($_[0], $_[1], $_[2]);
}

sub getgrgid {
    usage "getgrgid(gid)" if @_ != 1;
    CORE::getgrgid($_[0]);
}

sub getgrnam {
    usage "getgrnam(name)" if @_ != 1;
    CORE::getgrnam($_[0]);
}

sub atan2 {
    usage "atan2(x,y)" if @_ != 2;
    CORE::atan2($_[0], $_[1]);
}

sub cos {
    usage "cos(x)" if @_ != 1;
    CORE::cos($_[0]);
}

sub exp {
    usage "exp(x)" if @_ != 1;
    CORE::exp($_[0]);
}

sub fabs {
    usage "fabs(x)" if @_ != 1;
    CORE::abs($_[0]);
}

sub log {
    usage "log(x)" if @_ != 1;
    CORE::log($_[0]);
}

sub pow {
    usage "pow(x,exponent)" if @_ != 2;
    $_[0] ** $_[1];
}

sub sin {
    usage "sin(x)" if @_ != 1;
    CORE::sin($_[0]);
}

sub sqrt {
    usage "sqrt(x)" if @_ != 1;
    CORE::sqrt($_[0]);
}

sub getpwnam {
    usage "getpwnam(name)" if @_ != 1;
    CORE::getpwnam($_[0]);
}

sub getpwuid {
    usage "getpwuid(uid)" if @_ != 1;
    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];
}

sub raise {
    usage "raise(sig)" if @_ != 1;
    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]);
}

sub getchar {
    usage "getchar()" if @_ != 0;
    CORE::getc(STDIN);
}

sub gets {
    usage "gets()" if @_ != 0;
    scalar <STDIN>;
}

sub perror {
    print STDERR "@_: " if @_;
    print STDERR $!,"\n";
}

sub printf {
    usage "printf(pattern, args...)" if @_ < 1;
    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]);
}

sub rename {
    usage "rename(oldfilename, newfilename)" if @_ != 2;
    CORE::rename($_[0], $_[1]);
}

sub rewind {
    usage "rewind(filehandle)" if @_ != 1;
    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 {