view release on metacpan or  search on metacpan

lib/AnyEvent/DNS/EtcHosts.pm  view on Meta::CPAN

This is a wrapper for L<AnyEvent::DNS>->request method.

=cut

sub request {
    my ($self, $req, $cb) = @_;
    warn "req = " . Dumper $req if DEBUG;

    my $node = my $domain = $req->{qd}[0][0];
    $node =~ s/^_[a-z0-9-]*\._[a-z0-9-]*\.// if ($req->{qd}[0][1] eq 'srv');

    my $type = $req->{qd}[0][1];

    my (@ipv4, @ipv6, @srv);

    my $cv = AE::cv;

    $cv->begin;
    _load_hosts_unless {
        if (exists $HOSTS{$node}) {
            if ($type =~ /^([*]|srv)$/) {
                push @srv, $node;
            }
            if (ref $HOSTS{$node} eq 'ARRAY') {
                if ($type =~ /^([*]|a)$/ and exists $HOSTS{$node}[0]) {
                    push @ipv4, @{ $HOSTS{$node}[0] };
                }
                if ($type =~ /^([*]|aaaa)$/ and exists $HOSTS{$node}[1]) {
                    push @ipv6, @{ $HOSTS{$node}[1] };
                }
            }
        }

        if (@ipv4 or @ipv6 or @srv) {
            my $res = {
                id => int rand(0xffff),
                op => 'query',
                rc => 'noerror',
                qr => 1,
                aa => '',
                tc => '',
                rd => $req->{rd},
                ra => 1,
                ad => '',
                cd => '',
                qd => $req->{qd},
                an => [
                    (map { [$domain, 'srv', 'in', 0, 0, 0, 0, $_] } @srv),
                    (map { [$node, 'a', 'in', 0, AnyEvent::Socket::format_ipv4 $_ ] } @ipv4),
                    (map { [$node, 'aaaa', 'in', 0, AnyEvent::Socket::format_ipv6 $_ ] } @ipv6),
                ],
                ns => [],
                ar => [],
            };

            warn "res = " . Dumper $res if DEBUG;

            return $cb->($res);
        }

        return $self->SUPER::request(
            $req,
            sub {
                my ($res) = @_;
                warn "SUPER::request res = " . Dumper $res if DEBUG;
                $cb->($res);
            }
        );

    }
    $cv;

    return;
}

1;

__END__

=for readme continue

=head1 SEE ALSO

L<AnyEvent::DNS>,
L<AnyEvent::Socket>.

=head1 BUGS

This module might be incompatible with further versions of L<AnyEvent> module.

If you find the bug or want to implement new features, please report it at
L<https://github.com/dex4er/perl-AnyEvent-DNS-EtcHosts/issues>

The code repository is available at
L<http://github.com/dex4er/perl-AnyEvent-DNS-EtcHosts>

=head1 AUTHORS

Piotr Roszatycki <dexter@cpan.org>

Helper functions taken from AnyEvent::Socket 7.05 by
Marc Lehmann <schmorp@schmorp.de>

=head1 LICENSE

Copyright (c) 2013-2014, 2023 Piotr Roszatycki <dexter@cpan.org>.

This is free software; you can redistribute it and/or modify it under
the same terms as perl itself.

See L<http://dev.perl.org/licenses/artistic.html>