The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::BitTorrent::Protocol::BEP03::Tracker::HTTP;
{
    use Moose;
    use Moose::Util::TypeConstraints;
    use List::Util qw[shuffle];
    our $MAJOR = 0.074; our $MINOR = 0; our $DEV = 1; our $VERSION = sprintf('%1.3f%03d' . ($DEV ? (($DEV < 0 ? '' : '_') . '%03d') : ('')), $MAJOR, $MINOR, abs $DEV);
    use lib '../../../../../';
    use Net::BitTorrent::Types qw[:tracker :bencode];
    use Net::BitTorrent::Network::Utility qw[client];
    use Net::BitTorrent::Protocol::BEP23::Compact qw[uncompact_ipv4];
    has 'url' => (isa      => subtype(as Str => where {m[^http://.+]}),
                  is       => 'ro',
                  required => 1,
    );
    my $bdecode_constraint;

    sub scrape {
        my ($self, @infohash) = @_;

        #use Data::Dump;
        #ddx \@infohash;
        #ddx $self;
        #warn $self->torrent->infohash;
        return if $self->url !~ m[^(.+)/announce(\b(?:[^/])*)$];

        #warn sprintf '%s/scrape%s', $1, $2 || '';
        #die 'scrape! ' . $self->url;
        my $url = $self->url;
        if ($url =~ m[(.+)/announce(\b(?:[^/])*)]) {
        }
    }

    sub announce {
        my ($self, $event, $args, $code) = @_;
        use Scalar::Util;
        Scalar::Util::weaken $self;
        Scalar::Util::weaken $code;
        my $query;
        my %query_hash = (
                 info_hash  => $args->{'info_hash'},
                 peer_id    => $args->{'peer_id'},
                 port       => $args->{'port'},
                 uploaded   => $args->{'uploaded'},
                 downloaded => $args->{'downloaded'},
                 left       => $args->{'left'},
                 key        => $^T,
                 numwant    => 200,
                 compact    => 1,
                 no_peer_id => 1,
                 (defined $event && $event =~ m[^(?:st(?:art|opp)|complet)ed$]
                  ? (event => $event)
                  : ()
                 )
        );
        my $url
            = $self->url
            . ($self->url =~ qr[\?] ? $self->url =~ qr[&$] ? '' : '&' : '?')
            . join '&', map { $_ . '=' . $query_hash{$_} } keys %query_hash;
        my ($host, $port, $path)
            = $url =~ m{^https?://([^/:]*)(?::(\d+))?(/.*)$};
        $port //= 80;
        my $http;
        $http = client(
            $host, $port,
            sub {
                my $data = '';
                my ($sock, $_host, $_port) = @_;
                return if !$sock;
                syswrite($sock,
                         join "\015\012",
                         "GET $path HTTP/1.0",
                         'Connection: close',
                         "Host: $host:$port",
                         'Accept: text/plain',
                         'Accept-Encoding:',
                         'User-Agent: Net::BitTorrent/'
                             . $Net::BitTorrent::VERSION,
                         '',
                         ''
                );
                shutdown $sock, 1;
                $http = AE::io(
                    $sock, 0,    # read
                    sub {
                        if (!sysread($sock, $data, 1024 * 128, length $data))
                        {        # We must be finished. Parse it out.
                            shutdown $sock, 0;
                            $http = undef;
                            close $sock;
                            my ($header, $content)
                                = $data =~ m[^(.+)?(?:\015?\012){2}(.+)$]s;
                            $bdecode_constraint //=
                                Moose::Util::TypeConstraints::find_type_constraint(
                                                          'NBTypes::Bdecode');
                            my $announce
                                = $bdecode_constraint->coerce($content);
                            $announce->{'peers'}
                                = [uncompact_ipv4($announce->{'peers'})]
                                if $announce->{'peers'};
                            $query->[1]->($announce)    # if $code;
                        }
                    }
                );
            }
        );
        $query = [\%query_hash, $code, [], $http];
        return $query;
    }
    1;
}

=pod

=head1 NAME

Net::BitTorrent::Protocol::BEP03::Tracker::HTTP - A single HTTP-based tracker

=head1 See Also

=over

=item BEP 03:

http://bittorrent.org/beps/bep_0003.html

=back

=head1 Author

Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/

CPAN ID: SANKO

=head1 License and Legal

Copyright (C) 2008-2010 by Sanko Robinson <sanko@cpan.org>

This program is free software; you can redistribute it and/or modify it under
the terms of
L<The Artistic License 2.0|http://www.perlfoundation.org/artistic_license_2_0>.
See the F<LICENSE> file included with this distribution or
L<notes on the Artistic License 2.0|http://www.perlfoundation.org/artistic_2_0_notes>
for clarification.

When separated from the distribution, all original POD documentation is
covered by the
L<Creative Commons Attribution-Share Alike 3.0 License|http://creativecommons.org/licenses/by-sa/3.0/us/legalcode>.
See the
L<clarification of the CCA-SA3.0|http://creativecommons.org/licenses/by-sa/3.0/us/>.

Neither this module nor the L<Author|/Author> is affiliated with BitTorrent,
Inc.

=for rcs $Id: HTTP.pm 28e226d 2010-07-10 22:55:33Z sanko@cpan.org $

=cut