Net-DNS-Native
view release on metacpan or search on metacpan
sigset_t blocked_sig;
#endif
sem_t semaphore;
bstree* fd_map;
queue* in_queue;
int active_threads_cnt;
int pool;
char extra_thread;
char notify_on_begin;
int extra_threads_cnt;
int busy_threads;
queue* tout_queue;
char need_pool_reinit;
PerlInterpreter *perl;
} Net_DNS_Native;
typedef struct {
Net_DNS_Native *self;
char *host;
char *service;
struct addrinfo *hints;
void *DNS_pool_worker(void *v_arg) {
Net_DNS_Native *self = (Net_DNS_Native*)v_arg;
#ifndef WIN32
pthread_sigmask(SIG_BLOCK, &self->blocked_sig, NULL);
#endif
while (sem_wait(&self->semaphore) == 0) {
pthread_mutex_lock(&self->mutex);
void *arg = queue_shift(self->in_queue);
if (arg != NULL) self->busy_threads++;
pthread_mutex_unlock(&self->mutex);
if (arg == NULL) {
// this was request to quit thread
break;
}
DNS_getaddrinfo(arg);
pthread_mutex_lock(&self->mutex);
self->busy_threads--;
pthread_mutex_unlock(&self->mutex);
}
DNS_on_thread_finish(self);
return NULL;
}
void *DNS_extra_worker(void *v_arg) {
Net_DNS_Native *self = (Net_DNS_Native*)v_arg;
char stop = 0;
void *arg = queue_shift(self->in_queue);
pthread_mutex_unlock(&self->mutex);
if (arg == NULL) {
break;
}
DNS_getaddrinfo(arg);
pthread_mutex_lock(&self->mutex);
if (!queue_size(self->in_queue) || (self->pool && self->busy_threads < self->pool)) {
// extra worker may stop if queue is empty or there is free worker from the pool
stop = 1;
}
pthread_mutex_unlock(&self->mutex);
if (stop)
break;
}
DNS_on_thread_finish(self);
while (!queue_iterator_end(it)) {
self = queue_at(DNS_instances, it);
pthread_mutex_unlock(&self->mutex);
if (self->pool) DNS_unlock_semaphore(&self->semaphore);
// reinitialize stuff
DNS_free_timedout(self, 1);
self->active_threads_cnt = 0;
self->extra_threads_cnt = 0;
self->busy_threads = 0;
self->perl = PERL_GET_THX;
if (self->pool) {
#ifdef __NetBSD__
// unfortunetly under NetBSD threads created here will misbehave
self->need_pool_reinit = 1;
#else
DNS_reinit_pool(self);
#endif
}
croak("odd number of parameters");
Newx(self, 1, Net_DNS_Native);
int i, rc;
self->pool = 0;
self->notify_on_begin = 0;
self->extra_thread = 0;
self->active_threads_cnt = 0;
self->extra_threads_cnt = 0;
self->busy_threads = 0;
self->need_pool_reinit = 0;
self->perl = PERL_GET_THX;
#ifndef WIN32
sigfillset(&self->blocked_sig);
#endif
char *opt;
for (i=1; i<items; i+=2) {
opt = SvPV_nolen(ST(i));
arg->service = strlen(service) ? savepv(service) : NULL;
arg->hints = hints;
arg->extra = 0;
arg->queued = 0;
arg->res = res;
pthread_mutex_lock(&self->mutex);
DNS_free_timedout(self, 0);
bstree_put(self->fd_map, fd[0], res);
if (self->pool) {
if (self->busy_threads == self->pool && (self->extra_thread || queue_size(self->tout_queue) > self->extra_threads_cnt)) {
arg->extra = 1;
self->extra_threads_cnt++;
}
else {
arg->queued = 1;
queue_push(self->in_queue, arg);
sem_post(&self->semaphore);
}
}
pthread_mutex_unlock(&self->mutex);
lib/Net/DNS/Native.pm view on Meta::CPAN
=item pool => $size
If $size>0 will create thread pool with size=$size which will make resolving job. Otherwise will use default behavior:
create and finish thread for each resolving request. If thread pool is not enough big to process all supplied requests, than this
requests will be queued until one of the threads will become free to process next request from the queue.
=item extra_thread => $bool
If pool option specified and $bool has true value will create temporary extra thread for each request that can't be handled by the
pool (when all workers in the pool are busy) instead of pushing it to the queue. This temporary thread will be finished immediatly
after it will process request.
=item notify_on_begin => $bool
Extra mechanizm to notify caller that resolving for some host started. This is usefull for those who uses thread pool without C<extra_thread>
option. When pool becomes full new queries will be queued, so you can specify C<$bool> with true value if you want to receive notifications
when resolving will be really started. To notify it will simply make C<$handle> received by methods below readable. After that you will need to read
data from this handle to make it non readable again, so you can receive next notification, when host resolving will be done. There will be 1 byte
of data which you should read. C<"1"> for notification about start of the resolving and C<"2"> for notification about finish of the resolving.
lib/Net/DNS/Native.pm view on Meta::CPAN
C<($name,$aliases,$addrtype,$length,@addrs)> in list context.
B<NOTE:> it is important to call get_result() on returned handle when it will become ready for read. Because this method destroys resources
associated with this handle. Otherwise you will get memory leaks.
=head2 timedout($handle)
Mark resolving operation associated with this handle as timed out. This will not interrupt resolving operation (because there is no way to interrupt getaddrinfo(3) correctly),
but will automatically discard any results returned when resolving will be done. So, after C<timedout($handle)> you can forget about C<$handle> and
associated resolving operation. And don't need to call C<get_result($handle)> to destroy resources associated with this handle. Furthermore, if you are using thread pool
and all threads in pool are busy and C<extra_thread> option not specified, but 1 resolving operation from this pool marked as timed out and you'll add one more resolving operation,
this operation will not be queued. Instead of this 1 temporary extra thread will be created to process this operation. So you can think about C<timedout> like about real interrupter of
long running resolving operation. But you are warned how it really works. B<Note:> since 0.16 handles will be automatically marked as timedout during destruction, so you no need more to
call C<timedout($handle)> yourself, just lose last reference to this handle.
=head1 AUTHOR
Oleg G, E<lt>oleg@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
( run in 0.335 second using v1.01-cache-2.11-cpan-87723dcf8b7 )