threads.pm

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

package threads;

use 5.008;

use strict;
use warnings;

our $VERSION = '1.67';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;

# Verify this Perl supports threads
require Config;
if (! $Config::Config{useithreads}) {
    die("This Perl not built to support threads\n");
}

# Complain if 'threads' is loaded after 'threads::shared'
if ($threads::shared::threads_shared) {
    warn <<'_MSG_';
Warning, threads::shared has already been loaded.  To
enable shared variables, 'use threads' must be called
before threads::shared or any module that uses it.
_MSG_
}

# Declare that we have been loaded
$threads::threads = 1;

# Load the XS code
require XSLoader;
XSLoader::load('threads', $XS_VERSION);


### Export ###

sub import
{
    my $class = shift;   # Not used

    # Exported subroutines
    my @EXPORT = qw(async);

    # Handle args
    while (my $sym = shift) {
        if ($sym =~ /^(?:stack|exit)/i) {
            if (defined(my $arg = shift)) {
                if ($sym =~ /^stack/i) {
                    threads->set_stack_size($arg);
                } else {
                    $threads::thread_exit_only = $arg =~ /^thread/i;
                }
            } else {
                require Carp;
                Carp::croak("threads: Missing argument for option: $sym");
            }

        } elsif ($sym =~ /^str/i) {
            import overload ('""' => \&tid);

        } elsif ($sym =~ /^(?::all|yield)$/) {
            push(@EXPORT, qw(yield));

        } else {
            require Carp;
            Carp::croak("threads: Unknown import option: $sym");
        }
    }

    # Export subroutine names
    my $caller = caller();
    foreach my $sym (@EXPORT) {
        no strict 'refs';
        *{$caller.'::'.$sym} = \&{$sym};
    }

    # Set stack size via environment variable
    if (exists($ENV{'PERL5_ITHREADS_STACK_SIZE'})) {
        threads->set_stack_size($ENV{'PERL5_ITHREADS_STACK_SIZE'});
    }
}


### Methods, etc. ###

# Exit from a thread (only)
sub exit
{
    my ($class, $status) = @_;
    if (! defined($status)) {
        $status = 0;
    }

    # Class method only
    if (ref($class)) {
        require Carp;
        Carp::croak('Usage: threads->exit(status)');
    }

    $class->set_thread_exit_only(1);
    CORE::exit($status);
}

# 'Constant' args for threads->list()
sub threads::all      { }
sub threads::running  { 1 }
sub threads::joinable { 0 }

# 'new' is an alias for 'create'
*new = \&create;

# 'async' is a function alias for the 'threads->create()' method
sub async (&;@)
{
    unshift(@_, 'threads');
    # Use "goto" trick to avoid pad problems from 5.8.1 (fixed in 5.8.2)
    goto &create;
}

# Thread object equality checking
use overload (
    '==' => \&equal,
    '!=' => sub { ! equal(@_) },
    'fallback' => 1
);

1;

__END__

=head1 NAME

threads - Perl interpreter-based threads

=head1 VERSION

This document describes threads version 1.67

=head1 SYNOPSIS

    use threads ('yield',
                 'stack_size' => 64*4096,
                 'exit' => 'threads_only',
                 'stringify');

    sub start_thread {
        my @args = @_;
        print('Thread started: ', join(' ', @args), "\n");
    }
    my $thr = threads->create('start_thread', 'argument');
    $thr->join();

    threads->create(sub { print("I am a thread\n"); })->join();

    my $thr2 = async { foreach (@files) { ... } };
    $thr2->join();
    if (my $err = $thr2->error()) {
        warn("Thread error: $err\n");
    }

    # Invoke thread in list context (implicit) so it can return a list
    my ($thr) = threads->create(sub { return (qw/a b c/); });
    # or specify list context explicitly
    my $thr = threads->create({'context' => 'list'},
                              sub { return (qw/a b c/); });
    my @results = $thr->join();

    $thr->detach();

    # Get a thread's object
    $thr = threads->self();
    $thr = threads->object($tid);

    # Get a thread's ID
    $tid = threads->tid();
    $tid = $thr->tid();
    $tid = "$thr";

    # Give other threads a chance to run
    threads->yield();
    yield();

    # Lists of non-detached threads
    my @threads = threads->list();
    my $thread_count = threads->list();

    my @running = threads->list(threads::running);
    my @joinable = threads->list(threads::joinable);

    # Test thread objects
    if ($thr1 == $thr2) {
        ...
    }

    # Manage thread stack size
    $stack_size = threads->get_stack_size();
    $old_size = threads->set_stack_size(32*4096);

    # Create a thread with a specific context and stack size
    my $thr = threads->create({ 'context'    => 'list',
                                'stack_size' => 32*4096,
                                'exit'       => 'thread_only' },
                              \&foo);

    # Get thread's context
    my $wantarray = $thr->wantarray();

    # Check thread's state
    if ($thr->is_running()) {
        sleep(1);
    }
    if ($thr->is_joinable()) {
        $thr->join();
    }

    # Send a signal to a thread
    $thr->kill('SIGUSR1');

    # Exit a thread
    threads->exit();

=head1 DESCRIPTION

Perl 5.6 introduced something called interpreter threads.  Interpreter threads
are different from I<5005threads> (the thread model of Perl 5.005) by creating
a new Perl interpreter per thread, and not sharing any data or state between
threads by default.

Prior to Perl 5.8, this has only been available to people embedding Perl, and
for emulating fork() on Windows.

The I<threads> API is loosely based on the old Thread.pm API. It is very
important to note that variables are not shared between threads, all variables
are by default thread local.  To use shared variables one must also use
L<threads::shared>:

    use threads;
    use threads::shared;

It is also important to note that you must enable threads by doing C<use
threads> as early as possible in the script itself, and that it is not
possible to enable threading inside an C<eval "">, C<do>, C<require>, or
C<use>.  In particular, if you are intending to share variables with
L<threads::shared>, you must C<use threads> before you C<use threads::shared>.
(C<threads> will emit a warning if you do it the other way around.)

=over

=item $thr = threads->create(FUNCTION, ARGS)

This will create a new thread that will begin execution with the specified
entry point function, and give it the I<ARGS> list as parameters.  It will
return the corresponding threads object, or C<undef> if thread creation failed.

I<FUNCTION> may either be the name of a function, an anonymous subroutine, or
a code ref.

    my $thr = threads->create('func_name', ...);
        # or
    my $thr = threads->create(sub { ... }, ...);
        # or
    my $thr = threads->create(\&func, ...);

The C<-E<gt>new()> method is an alias for C<-E<gt>create()>.

=item $thr->join()

This will wait for the corresponding thread to complete its execution.  When
the thread finishes, C<-E<gt>join()> will return the return value(s) of the
entry point function.

The context (void, scalar or list) for the return value(s) for C<-E<gt>join()>
is determined at the time of thread creation.

    # Create thread in list context (implicit)
    my ($thr1) = threads->create(sub {
                                    my @results = qw(a b c);
                                    return (@results);
                                 });
    #   or (explicit)
    my $thr1 = threads->create({'context' => 'list'},
                               sub {
                                    my @results = qw(a b c);
                                    return (@results);
                               });
    # Retrieve list results from thread
    my @res1 = $thr1->join();

    # Create thread in scalar context (implicit)
    my $thr2 = threads->create(sub {
                                    my $result = 42;
                                    return ($result);
                                 });
    # Retrieve scalar result from thread
    my $res2 = $thr2->join();

    # Create a thread in void context (explicit)
    my $thr3 = threads->create({'void' => 1},
                               sub { print("Hello, world\n"); });
    # Join the thread in void context (i.e., no return value)
    $thr3->join();

See L</"THREAD CONTEXT"> for more details.

If the program exits without all threads having either been joined or
detached, then a warning will be issued.

Calling C<-E<gt>join()> or C<-E<gt>detach()> on an already joined thread will
cause an error to be thrown.

=item $thr->detach()

Makes the thread unjoinable, and causes any eventual return value to be
discarded.  When the program exits, any detached threads that are still
running are silently terminated.

If the program exits without all threads having either been joined or
detached, then a warning will be issued.

Calling C<-E<gt>join()> or C<-E<gt>detach()> on an already detached thread
will cause an error to be thrown.

=item threads->detach()

Class method that allows a thread to detach itself.

=item threads->self()

Class method that allows a thread to obtain its own I<threads> object.

=item $thr->tid()

Returns the ID of the thread.  Thread IDs are unique integers with the main
thread in a program being 0, and incrementing by 1 for every thread created.

=item threads->tid()

Class method that allows a thread to obtain its own ID.

=item "$thr"

If you add the C<stringify> import option to your C<use threads> declaration,
then using a threads object in a string or a string context (e.g., as a hash
key) will cause its ID to be used as the value: