File Coverage

blib/lib/Net/BitTorrent/Torrent.pm

Criterion	Covered	Total	%
statement	581	712	81.6
branch	226	372	60.7
condition	55	117	47.0
subroutine	80	88	90.9
pod	37	37	100.0
total	979	1326	73.8

#!/usr/bin/perl -w
package Net::BitTorrent::Torrent;
{
    use strict;
    use warnings;
    use Digest::SHA qw[sha1_hex];
    use Carp qw[carp carp];
    use Cwd qw[cwd];
    use File::Spec::Functions qw[rel2abs catfile];
    use Scalar::Util qw[blessed weaken refaddr];
    use List::Util qw[sum shuffle max min];
    use Fcntl qw[/O_/ /SEEK/ :flock];
    use vars qw[@EXPORT_OK %EXPORT_TAGS];
    use Exporter qw[];
    *import = *import = *Exporter::import;
    @EXPORT_OK = qw[
        STARTED CHECKING START_AFTER_CHECK CHECKED
        ERROR   PAUSED   LOADED            QUEUED
    ];
    %EXPORT_TAGS = (status => [@EXPORT_OK], all => [@EXPORT_OK]);
    use lib q[../../../lib];
    use Net::BitTorrent::Util qw[:bencode :compact];
    use Net::BitTorrent::Peer qw[];
    use Net::BitTorrent::Torrent::File;
    use Net::BitTorrent::Torrent::Tracker;
    use version qw[qv];
    our $VERSION_BASE = 51; our $UNSTABLE_RELEASE = 0; our $VERSION = sprintf(($UNSTABLE_RELEASE ? q[%.3f_%03d] : q[%.3f]), (version->new(($VERSION_BASE))->numify / 1000), $UNSTABLE_RELEASE);
    my %REGISTRY = ();
    my @CONTENTS = \my (%_client,  %path,            %_basedir,
                        %size,     %files,           %trackers,
                        %infohash, %uploaded,        %downloaded,
                        %bitfield, %_working_pieces, %_block_length,
                        %raw_data, %status,          %error,
                        %_event,   %resume_path,     %_nodes
    );
    sub STARTED           {1}
    sub CHECKING          {2}
    sub START_AFTER_CHECK {4}
    sub CHECKED           {8}
    sub ERROR             {16}
    sub PAUSED            {32}
    sub LOADED            {64}
    sub QUEUED            {128}

    sub new {
        my ($class, $args) = @_;
        my $self = bless \$class, $class;
        if ((!$args) || (ref($args) ne q[HASH])) {
            carp q[Net::BitTorrent::Torrent->new({ }) requires ]
                . q[parameters to be passed as a hashref];
            return;
        }
        if (!$args->{q[Path]}) {
            carp
                sprintf(
                q[Net::BitTorrent::Torrent->new({ }) requires a 'Path' parameter]
                );
            return;
        }
        if (not -f $args->{q[Path]}) {
            carp
                sprintf(
                       q[Net::BitTorrent::Torrent->new({ }) cannot find '%s'],
                       $args->{q[Path]});
            return;
        }
        if (($args->{q[Client]})
            && (   (!blessed $args->{q[Client]})
                || (!$args->{q[Client]}->isa(q[Net::BitTorrent])))
            )
        {   carp q[Net::BitTorrent::Torrent->new({ }) requires a ]
                . q[blessed Net::BitTorrent object in the 'Client' parameter];
            return;
        }
        if (    $args->{q[BlockLength]}
            and $args->{q[BlockLength]} !~ m[^\d+$])
        {   carp q[Net::BitTorrent::Torrent->new({ }) requires an ]
                . q[integer 'BlockLength' parameter];
            delete $args->{q[BlockLength]};
        }
        if ($args->{q[Status]} and $args->{q[Status]} !~ m[^\d+$]) {
            carp q[Net::BitTorrent::Torrent->new({ }) requires an ]
                . q[integer 'Status' parameter.  Falling back to defaults.];
            delete $args->{q[Status]};
        }
        $args->{q[Path]} = rel2abs($args->{q[Path]});
        $args->{q[BaseDir]} = rel2abs(
                  defined($args->{q[BaseDir]}) ? $args->{q[BaseDir]} : cwd());
        my ($TORRENT_FH, $TORRENT_RAW);
        if (not sysopen($TORRENT_FH, $args->{q[Path]}, O_RDONLY)) {
            carp
                sprintf(
                q[Net::BitTorrent::Torrent->new({ }) could not open '%s': %s],
                $args->{q[Path]}, $!);
            return;
        }
        flock($TORRENT_FH, LOCK_SH);
        if (sysread($TORRENT_FH, $TORRENT_RAW, -s $args->{q[Path]})
            != -s $args->{q[Path]})
        {   carp sprintf(
                q[Net::BitTorrent::Torrent->new({ }) could not read all %d bytes of '%s' (Read %d instead)],
                -s $args->{q[Path]},
                $args->{q[Path]}, length($TORRENT_RAW)
            );
            return;
        }
        flock($TORRENT_FH, LOCK_UN);
        $raw_data{refaddr $self} = bdecode($TORRENT_RAW);
        close($TORRENT_FH);
        undef $TORRENT_FH;
        undef $TORRENT_RAW;
        if (!$raw_data{refaddr $self}) {
            carp q[Malformed .torrent];
            return;
        }
        if (length(unpack(q[H*], $raw_data{refaddr $self}{q[info]}{q[pieces]})
            ) < 40
            )
        {   return;
        }
        if (length(unpack(q[H*], $raw_data{refaddr $self}{q[info]}{q[pieces]})
            ) % 40
            )
        {   return;
        }
        $infohash{refaddr $self}
            = sha1_hex(bencode($raw_data{refaddr $self}{q[info]}));
        $path{refaddr $self}            = $args->{q[Path]};
        $_basedir{refaddr $self}        = $args->{q[BaseDir]};
        $_working_pieces{refaddr $self} = {};
        $_block_length{refaddr $self} = (defined $args->{q[BlockLength]}
                                         ? $args->{q[BlockLength]}
                                         : (2**14)
        );
        $downloaded{refaddr $self} = 0;
        $uploaded{refaddr $self}   = 0;
        $_nodes{refaddr $self}     = q[];
        ${$bitfield{refaddr $self}}
            = pack(q[b*], qq[\0] x $self->piece_count);
        my @_files;

        if (defined $raw_data{refaddr $self}{q[info]}{q[files]}) {
            for my $file (@{$raw_data{refaddr $self}{q[info]}{q[files]}}) {
                push @_files,
                    [catfile($_basedir{refaddr $self},
                             $raw_data{refaddr $self}{q[info]}{q[name]},
                             @{$file->{q[path]}}
                     ),
                     $file->{q[length]}
                    ];
            }
        }
        else {
            push @_files,
                [catfile($_basedir{refaddr $self},
                         $raw_data{refaddr $self}{q[info]}{q[name]}
                 ),
                 $raw_data{refaddr $self}{q[info]}{q[length]}
                ];
        }
        $size{refaddr $self} = 0;
        for my $_file (@_files) {
            my ($path, $size) = @$_file;
            $path =~ s[\.\.][]g;
            $path =~ m[(.+)];
            $path = $1;
            if (    defined $raw_data{refaddr $self}{q[encoding]}
                and $raw_data{refaddr $self}{q[encoding]} !~ m[^utf-?8$]i
                and not utf8::is_utf8($path)
                and require Encode)
            {   $path =
                    Encode::decode(Encode::find_encoding(
                                         $raw_data{refaddr $self}{q[encoding]}
                                       )->name,
                                   $path
                    );
            }
            push(@{$files{refaddr $self}},
                 Net::BitTorrent::Torrent::File->new(
                                 {Size    => $size,
                                  Path    => $path,
                                  Torrent => $self,
                                  Index   => scalar(@{$files{refaddr $self}})
                                 }
                 )
            );
            $size{refaddr $self} += $size;
        }
        $trackers{refaddr $self} = [];
        foreach my $_tier ($raw_data{refaddr $self}{q[announce-list]}
                           ? @{$raw_data{refaddr $self}{q[announce-list]}}
                           : $raw_data{refaddr $self}{q[announce]}
                           ? [$raw_data{refaddr $self}{q[announce]}]
                           : ()
            )
        {   push(@{$trackers{refaddr $self}},
                 Net::BitTorrent::Torrent::Tracker->new(
                                            {Torrent => $self, URLs => $_tier}
                 )
            );
        }
        if (   ($args->{q[Client]})
            && (blessed $args->{q[Client]})
            && ($args->{q[Client]}->isa(q[Net::BitTorrent])))
        {   foreach my $_node ($raw_data{refaddr $self}{q[nodes]}
                               ? @{$raw_data{refaddr $self}{q[nodes]}}
                               : ()
                )
            {   $args->{q[Client]}->_dht->add_node(
                                    {ip => $_node->[0], port => $_node->[1]});
            }
        }
        $args->{q[Status]} ||= 0;
        $args->{q[Status]} ^= CHECKING if $args->{q[Status]} & CHECKING;
        $args->{q[Status]} ^= CHECKED  if $args->{q[Status]} & CHECKED;
        $args->{q[Status]} ^= ERROR    if $args->{q[Status]} & ERROR;
        $args->{q[Status]} ^= LOADED   if $args->{q[Status]} & LOADED;
        ${$status{refaddr $self}} = $args->{q[Status]};
        ${$status{refaddr $self}} |= LOADED;
        ${$error{refaddr $self}} = undef;

        # Resume system v2
        my $_start = 1;
        $resume_path{refaddr $self} = undef;
        if ($args->{q[Resume]}) {
            $resume_path{refaddr $self} = $args->{q[Resume]};
            my $_resume_data;
            if (-f $args->{q[Resume]}) {
                open(my ($_RD), q[<], $resume_path{refaddr $self});
                sysread($_RD, $_resume_data, -s $_RD);
                close $_RD;
            }
            if ($_resume_data) {
                $_start       = 0;
                $_resume_data = bdecode($_resume_data);

                # Resume system
                if (   $_resume_data->{q[.format]}
                    && $_resume_data->{q[.format]} eq
                    q[Net::BitTorrent resume]
                    && $_resume_data->{q[.version]}
                    && $_resume_data->{q[.version]} <= 2    # apiver
                    )
                {   $_nodes{refaddr $self}
                        = $_resume_data->{q[peers]}
                        ? $_resume_data->{q[peers]}
                        : q[];
                    my $_okay = 1;
                    for my $_index (0 .. $#{$files{refaddr $self}}) {
                        if ((!-f $files{refaddr $self}->[$_index]->path
                             && $_resume_data->{q[files]}[$_index]{q[mtime]}
                            )
                            || ((stat($files{refaddr $self}->[$_index]->path))
                                [9]
                                || 0 != $_resume_data->{q[files]}[$_index]
                                {q[mtime]})
                            )
                        {   ${$status{refaddr $self}} |= START_AFTER_CHECK;
                            $_okay = 0;
                        }
                        $files{refaddr $self}->[$_index]->set_priority(
                             $_resume_data->{q[files]}[$_index]{q[priority]});
                    }
                    if (!$_okay) {
                        $self->_set_error(
                                       q[Bad resume data. Please hashcheck.]);
                    }
                    else {
                        ${$bitfield{refaddr $self}}
                            = $_resume_data->{q[bitfield]};

                        # Accept resume data is the same as hashchecking
                        my $start_after_check
                            = ${$status{refaddr $self}} & START_AFTER_CHECK;
                        ${$status{refaddr $self}} ^= START_AFTER_CHECK
                            if ${$status{refaddr $self}} & START_AFTER_CHECK;
                        ${$status{refaddr $self}} ^= CHECKED
                            if !(${$status{refaddr $self}} & CHECKED);
                        if ($start_after_check) { $_start = 1; }

                        # Reload Blocks
                        for my $_piece (@{$_resume_data->{q[working]}}) {
                            $_working_pieces{refaddr $self}
                                {$_piece->{q[Index]}} = {
                                Index            => $_piece->{q[Index]},
                                Priority         => $_piece->{q[Priority]},
                                Blocks_Requested => [
                                     map { {} } 1 .. $_piece->{q[Block_Count]}
                                ],
                                Blocks_Received => [
                                    map {
                                        vec($_piece->{q[Blocks_Received]},
                                            $_, 1)
                                        } 1 .. $_piece->{q[Block_Count]}
                                ],
                                Block_Length => $_piece->{q[Block_Length]},
                                Block_Length_Last =>
                                    $_piece->{q[Block_Length_Last]},
                                Block_Count => $_piece->{q[Block_Count]},
                                Length      => $_piece->{q[Length]},
                                Endgame     => $_piece->{q[Endgame]},
                                Slow  => 1,     # $_piece->{q[Slow]},
                                mtime => time
                                };
                        }
                    }
                }
            }
        }

        # Threads stuff
        weaken($REGISTRY{refaddr $self} = $self);
        if ($threads::shared::threads_shared) {
            threads::shared::share($bitfield{refaddr $self});
            threads::shared::share($status{refaddr $self});
            threads::shared::share($error{refaddr $self});
        }
        $$self = $infohash{refaddr $self};
        if ($args->{q[Client]}) {
            $self->queue($args->{q[Client]});
            $_client{refaddr $self}->_schedule(
                                     {Time   => time + 25,
                                      Code   => sub { shift->_dht_announce },
                                      Object => $self
                                     }
            );
            $_client{refaddr $self}->_schedule(
                                       {Time   => time,
                                        Code   => sub { shift->_dht_scrape },
                                        Object => $self
                                       }
            );
        }
        $self->start if $_start && (${$status{refaddr $self}} & QUEUED);
        $self->_new_peer();    # XXX - temporary multi-thread vs schedule fix
        return $self;
    }

    # Accessors | Public
    sub infohash    { return $infohash{refaddr +shift}; }
    sub trackers    { return $trackers{refaddr +shift}; }
    sub bitfield    { return ${$bitfield{refaddr +shift}}; }
    sub path        { return $path{refaddr +shift}; }
    sub resume_path { return $resume_path{refaddr +shift}; }
    sub files       { return $files{refaddr +shift}; }
    sub size        { return $size{refaddr +shift}; }
    sub status      { return ${$status{refaddr +shift}}; }
    sub downloaded  { return $downloaded{refaddr +shift}; }
    sub uploaded    { return $uploaded{refaddr +shift}; }
    sub error       { return ${$error{refaddr +shift}}; }
    sub comment     { return $raw_data{refaddr +shift}{q[comment]}; }
    sub created_by  { return $raw_data{refaddr +shift}{q[created by]}; }

    sub creation_date {
        return $raw_data{refaddr +shift}{q[creation date]};
    }
    sub name { return $raw_data{refaddr +shift}{q[info]}{q[name]}; }

    sub private {
        return $raw_data{refaddr +shift}{q[info]}{q[private]} ? 1 : 0;
    }

    sub raw_data {
        my ($self, $raw) = @_;
        return $raw
            ? $raw_data{refaddr $self}
            : bencode $raw_data{refaddr $self};
    }

    sub is_complete {
        my ($self) = @_;
        return if (${$status{refaddr $self}} & CHECKING);
        return unpack(q[b*], $self->_wanted) !~ m[1] ? 1 : 0;
    }

    sub piece_count {    # XXX - cache?
        my ($self) = @_;
        return
            int(
               length(
                   unpack(q[H*], $raw_data{refaddr $self}{q[info]}{q[pieces]})
                   ) / 40
            );
    }

    sub peers {
        my ($self) = @_;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        my $_connections = $_client{refaddr $self}->_connections;
        return map {
            (    ($_->{q[Object]}->isa(q[Net::BitTorrent::Peer]))
             and ($_->{q[Object]}->torrent)
             and ($_->{q[Object]}->torrent eq $self))
                ? $_->{q[Object]}
                : ()
        } values %$_connections;
    }

    # Mutators | Private
    sub _add_node {
        my ($self, $node) = @_;
        return $_nodes{refaddr $self} .= compact($node);
    }

    sub _set_bitfield {
        my ($self, $new_value) = @_;
        return if (${$status{refaddr $self}} & CHECKING);
        return if length ${$bitfield{refaddr $self}} != length $new_value;

        # XXX - make sure bitfield conforms to what we expect it to be
        return ${$bitfield{refaddr $self}} = $new_value;
    }

    sub _set_status {
        my ($self, $new_value) = @_;
        return if (${$status{refaddr $self}} & CHECKING);

        # XXX - make sure status conforms to what we expect it to be
        return ${$status{refaddr $self}} = $new_value;
    }

    sub _set_error {
        my ($self, $msg) = @_;
        ${$error{refaddr $self}} = $msg;
        $self->stop() if ${$status{refaddr $self}} & STARTED;
        ${$status{refaddr $self}} |= ERROR;
        return 1;
    }

    sub _set_block_length {
        my ($self, $value) = @_;
        return if $value !~ m[^\d+$];
        return $_block_length{refaddr $self} = $value;
    }

    # Accessors | Private
    sub _client         { return $_client{refaddr +shift}; }
    sub _block_length   { return $_block_length{refaddr +shift} }
    sub _nodes          { return $_nodes{refaddr +shift}; }
    sub _working_pieces { return $_working_pieces{refaddr +shift}; }
    sub _basedir        { return $_basedir{refaddr +shift}; }

    sub _wanted {
        my ($self) = @_;
        my $wanted = q[0] x $self->piece_count;
        my $p_size = $raw_data{refaddr $self}{q[info]}{q[piece length]};
        my $offset = 0;
        for my $file (@{$files{refaddr $self}}) {
            my $start = ($offset / $p_size);
            my $end   = (($offset + $file->size) / $p_size);
            if ($file->priority ? 1 : 0) {
                substr($wanted, $start,
                       ($end - $start + 1),
                       (($file->priority ? 1 : 0) x ($end - $start + 1)));
            }
            $offset += $file->size;
        }
        return (
             pack(q[b*], $wanted)
                 | ${$bitfield{refaddr $self}} ^ ${$bitfield{refaddr $self}});
    }

    sub _weights {
        my ($self) = @_;
        my %_weights;
        my $p_size = $raw_data{refaddr $self}{q[info]}{q[piece length]};
        my $offset = 0;
        for my $file (@{$files{refaddr $self}}) {
            my $priority = $file->priority;
            my $start    = ($offset / $p_size);
            my $end      = (($offset + $file->size) / $p_size);
            $offset += $file->size;
            next if !$priority;
            grep {
                $_weights{$_} = $priority
                    if !vec(${$bitfield{refaddr $self}}, $_, 1)
            } $start .. $end;
        }
        return %_weights;
    }

    # Methods | Public
    sub hashcheck {
        my ($self) = @_;
        return if (${$status{refaddr $self}} & PAUSED);
        return if (${$status{refaddr $self}} & CHECKING);
        ${$bitfield{refaddr $self}}    # empty it first
            = pack(q[b*], qq[\0] x $self->piece_count);
        my $start_after_check = ${$status{refaddr $self}} & START_AFTER_CHECK;
        ${$status{refaddr $self}} |= CHECKING
            if !${$status{refaddr $self}} & CHECKING;
        for my $index (0 .. ($self->piece_count - 1)) {
            $self->_check_piece_by_index($index);
        }
        (${$status{refaddr $self}} ^= START_AFTER_CHECK)
            if ${$status{refaddr $self}} & START_AFTER_CHECK;
        ${$status{refaddr $self}} ^= CHECKED
            if !(${$status{refaddr $self}} & CHECKED);
        ${$status{refaddr $self}} ^= CHECKING
            if ${$status{refaddr $self}} & CHECKING;
        if ($start_after_check) { $self->start(); }
        return 1;
    }

    sub pause {
        my ($self) = @_;
        if (!${$status{refaddr $self}} & QUEUED) {
            carp q[Cannot pause an orphan torrent];
            return;
        }
        if (!${$status{refaddr $self}} & STARTED) {
            carp q[Cannot pause a stopped torrent];
            return;
        }
        return ${$status{refaddr $self}} |= PAUSED;
    }

    sub start {
        my ($self) = @_;
        return if !(${$status{refaddr $self}} & QUEUED);
        ${$status{refaddr $self}} ^= ERROR
            if ${$status{refaddr $self}} & ERROR;
        ${$status{refaddr $self}} ^= PAUSED
            if ${$status{refaddr $self}} & PAUSED;
        if (!(${$status{refaddr $self}} & STARTED)) {
            ${$status{refaddr $self}} |= STARTED;
            for my $tracker (@{$trackers{refaddr $self}}) {
                $tracker->_announce(q[started]);
            }
        }
        return ${$status{refaddr $self}};
    }

    sub stop {
        my ($self) = @_;
        return if !(${$status{refaddr $self}} & QUEUED);
        for my $_peer ($self->peers) {
            $_peer->_disconnect(q[Torrent has been stopped]);
        }
        for my $_file (@{$files{refaddr $self}}) { $_file->_close(); }
        if (${$status{refaddr $self}} & STARTED) {
            ${$status{refaddr $self}} ^= STARTED;
            for my $tracker (@{$trackers{refaddr $self}}) {
                $tracker->_announce(q[stopped]);
            }
        }
        return !!${$status{refaddr $self}} & STARTED;
    }

    sub queue {
        my ($self, $client) = @_;
        if (   (!$client)
            || (!blessed $client)
            || (!$client->isa(q[Net::BitTorrent])))
        {   carp q[Net::BitTorrent::Torrent->queue() requires a ]
                . q[blessed Net::BitTorrent object];
            return;
        }
        if ($_client{refaddr $self} or ${$status{refaddr $self}} & QUEUED) {
            carp q[Cannot serve the same .torrent more than once];
            return;
        }
        $_client{refaddr $self} = $client;
        weaken $_client{refaddr $self};
        ${$status{refaddr $self}} ^= QUEUED;

        #$self->_new_peer();
        return $_client{refaddr $self};
    }

    # Methods | Private
    sub _add_uploaded {
        my ($self, $amount) = @_;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        return if not $amount;
        $uploaded{refaddr $self} += (($amount =~ m[^\d+$]) ? $amount : 0);
    }

    sub _add_downloaded {
        my ($self, $amount) = @_;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        $downloaded{refaddr $self} += (($amount =~ m[^\d+$]) ? $amount : 0);
    }

    sub _new_peer {
        my ($self) = @_;
        return if not defined $_client{refaddr $self};
        $_client{refaddr $self}->_schedule(
                             {Time => time + ($self->is_complete ? 60 : 5),
                              Code => sub { shift->_new_peer if @_; },
                              Object => $self
                             }
        );
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & STARTED);
        return if !(${$status{refaddr $self}} & QUEUED);

        # Don't bother if we're at the hard limit
        return
            if scalar $self->peers
                >= $_client{refaddr $self}->_peers_per_torrent;

        #
        my $half_open = scalar(
            grep {
                $_->{q[Object]}->isa(q[Net::BitTorrent::Peer])
                    and not defined $_->{q[Object]}->peerid
                } values %{$_client{refaddr $self}->_connections}
        );

        #warn sprintf q[%d half open peers], $half_open;
        # List of peers to make sure we're not already connected to this peer
        my @peers = $self->peers;

        # If we haven't any nodes in cache, gather them from various sources
        if (!$_nodes{refaddr $self}) {
            $_nodes{refaddr $self}
                = $_client{refaddr $self}->_dht->_peers($self->infohash)
                if !$self->private;
            for my $tier (@{$trackers{refaddr $self}}) {
                for my $url (@{$tier->urls}) {
                    $_nodes{refaddr $self} .= $url->_peers;
                }
            }
        }

        # Don't bother if we haven't any nodes to try
        return if !$_nodes{refaddr $self};

        # Inflate the list and try them one-by-one
        my @nodes = uncompact($_nodes{refaddr $self});
        for ($half_open .. $_client{refaddr $self}->_half_open - 1) {
            last if !@nodes;
            my $node = shift @nodes;
            next
                if scalar grep {
                sprintf(q[%s:%d], ($_->host || q[]), ($_->port || 0)) eq
                    $node    # already connected to this peer
                } @peers;
            my $ok = $_client{refaddr $self}
                ->_event(q[ip_filter], {Address => $node});
            if (defined $ok and $ok == 0) { next; }
            my $peer =
                Net::BitTorrent::Peer->new({Address => $node,
                                            Torrent => $self,
                                            Source  => q[TODO]
                                           }
                );
        }

        # Store only nodes we haven't tried yet
        $_nodes{refaddr $self} = compact(@nodes);

        # Return
        return 1;
    }

    sub _add_tracker {
        my ($self, $tier) = @_;
        carp q[Please, pass new tier in an array ref...]
            unless ref $tier eq q[ARRAY];
        my $tracker = Net::BitTorrent::Torrent::Tracker->new(
                                           {Torrent => $self, URLs => $tier});
        $tracker->_announce(q[started]);
        return push(@{$trackers{refaddr $self}}, $tracker);
    }

    sub _piece_by_index {
        my ($self, $index) = @_;
        return if !${$status{refaddr $self}} & STARTED;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        if ((!defined $index) || ($index !~ m[^\d+$])) {
            carp
                q[Net::BitTorrent::Torrent->_piece_by_index() requires an index];
            return;
        }
        return $_working_pieces{refaddr $self}{$index}
            ? $_working_pieces{refaddr $self}{$index}
            : ();
    }

    sub _pick_piece {
        my ($self, $peer) = @_;
        return if $self->is_complete;
        return if !${$status{refaddr $self}} & STARTED;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        if (!$_client{refaddr $self}) {
            carp
                q[Net::BitTorrent::Torrent->_pick_piece(PEER) will not on an orphan torrent];
            return;
        }
        if (   (!${$status{refaddr $self}} & STARTED)
            || (${$status{refaddr $self}} & CHECKING))
        {   carp
                q[Net::BitTorrent::Torrent->_pick_piece(PEER) will not work while hashchecking];
            return;
        }
        if (   (!$peer)
            || (!blessed $peer)
            || (!$peer->isa(q[Net::BitTorrent::Peer])))
        {   carp
                q[Net::BitTorrent::Torrent->_pick_piece(PEER) requires a peer];
            return;
        }
        my $piece;
        my $_wanted   = $self->_wanted;
        my $relevence = $peer->bitfield & $_wanted;
        return if unpack(q[b*], $relevence) !~ m[1];
        my $endgame = (    # XXX - static ratio
            (sum(split(q[], unpack(q[b*], $_wanted)))
                 <= (length(unpack(q[b*], $_wanted)) * .1)
            ) ? 1 : 0
        );

        #warn sprintf q[Endgame | %d <= %d (%d) ? %d],
        #    sum(split(q[], unpack(q[b*], $_wanted))),
        #    (length(unpack(q[b*], $_wanted)) * .1),
        #    length(unpack(q[b*], $_wanted)),
        #    $endgame;
        my $unrequested_blocks = 0;
        for my $index (keys %{$_working_pieces{refaddr $self}}) {
            $unrequested_blocks += scalar grep {
                !keys %{$_working_pieces{refaddr $self}{$index}
                        {q[Blocks_Requested]}[$_]}
                } 0 .. $_working_pieces{refaddr $self}{$index}{q[Block_Count]}
                - 1;
        }
        if (scalar(grep { $_->{q[Slow]} == 1 }
                       values %{$_working_pieces{refaddr $self}}
            ) >= 3
            )
        {   my @indexes
                = grep { $_working_pieces{refaddr $self}{$_}{q[Slow]} == 1 }
                keys %{$_working_pieces{refaddr $self}};
            for my $index (@indexes) {
                if (vec($relevence, $index, 1) == 1) {
                    if (($endgame
                         ? index($_working_pieces{refaddr $self}{$index}
                                     {q[Blocks_Received]},
                                 0,
                                 0
                         )
                         : scalar grep { scalar keys %$_ }
                         @{  $_working_pieces{refaddr $self}{$index}
                                 {q[Blocks_Requested]}
                         }
                        ) != -1
                        )
                    {   $piece = $_working_pieces{refaddr $self}{$index};
                        last;
                    }
                }
            }
        }
        elsif (
            scalar(values %{$_working_pieces{refaddr $self}}) >= (
                (   $unrequested_blocks > (
                        int($raw_data{refaddr $self}{q[info]}{q[piece length]}
                                / $_block_length{refaddr $self}
                            ) / 4
                        ) ? 0 : 1
                ) + scalar keys %{$_working_pieces{refaddr $self}}
            )
            )
        {   my @indexes = sort {
                (scalar grep { scalar keys %$_ }
                     @{
                     $_working_pieces{refaddr $self}{$a}{q[Blocks_Requested]}
                     }
                    ) <=> (scalar grep { scalar keys %$_ }
                               @{
                               $_working_pieces{refaddr $self}{$b}
                                   {q[Blocks_Requested]}
                               }
                    )
            } keys %{$_working_pieces{refaddr $self}};
            for my $index (@indexes) {
                if (vec($relevence, $index, 1) == 1) {
                    if (($endgame
                         ? index($_working_pieces{refaddr $self}{$index}
                                     {q[Blocks_Received]},
                                 0,
                                 0
                         )
                         : scalar grep { scalar keys %$_ }
                         @{  $_working_pieces{refaddr $self}{$index}
                                 {q[Blocks_Requested]}
                         }
                        ) != -1
                        )
                    {   $piece = $_working_pieces{refaddr $self}{$index};
                        last;
                    }
                }
            }
        }
        else {
            my %weights = $self->_weights;
            return if not keys %weights;
            my $total    = sum values %weights;    # [id://230661]
            my $rand_val = $total * rand;
            my $index;
            for my $i (reverse sort keys %weights) {
                $rand_val -= $weights{$i};
                if ($rand_val <= 0
                    && vec($relevence, $i, 1) == 1)
                {   $index = $i;
                    last;
                }
            }
            return if not defined $index;
            my $_piece_length = (    # XXX - save some time and cache this?
                ($index == int(
                            $size{refaddr $self}
                          / $raw_data{refaddr $self}{q[info]}{q[piece length]}
                 )
                )
                ? ($size{refaddr $self} % $raw_data{refaddr $self}{q[info]}
                   {q[piece length]})
                : ($raw_data{refaddr $self}{q[info]}{q[piece length]})
            );
            my $block_length = (
                        ($raw_data{refaddr $self}{q[info]}{q[piece length]}
                             < $_block_length{refaddr $self}
                        )
                        ? ($raw_data{refaddr $self}{q[info]}{q[piece length]})
                        : $_block_length{refaddr $self}
            );
            my $block_length_last
                = ($raw_data{refaddr $self}{q[info]}{q[piece length]}
                   % $_piece_length);
            my $block_count
                = (int($_piece_length / $block_length)
                       + ($block_length_last ? 1 : 0));
            $piece = {Index             => $index,
                      Priority          => $weights{$index},
                      Blocks_Requested  => [map { {} } 1 .. $block_count],
                      Blocks_Received   => [map {0} 1 .. $block_count],
                      Block_Length      => $block_length,
                      Block_Length_Last => $block_length_last,
                      Block_Count       => $block_count,
                      Length            => $_piece_length,
                      Endgame           => $endgame,
                      Slow              => 1,
                      mtime             => 0
            };
        }
        if ($piece) {
            if (not
                defined $_working_pieces{refaddr $self}{$piece->{q[Index]}})
            {   $_working_pieces{refaddr $self}{$piece->{q[Index]}} = $piece;
                $_working_pieces{refaddr $self}{$piece->{q[Index]}}
                    {q[Endgame]} = $endgame;
            }
        }
        return $piece
            ? $_working_pieces{refaddr $self}{$piece->{q[Index]}}
            : ();
    }

    sub _write_data {
        my ($self, $index, $offset, $data) = @_;
        return if !${$status{refaddr $self}} & STARTED;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        if ((length($$data) + (
                 ($raw_data{refaddr $self}{q[info]}{q[piece length]} * $index)
                 + $offset
             )
            ) > $size{refaddr $self}
            )
        {   carp q[Too much data or bad offset data for this torrent];
            return;
        }
        my $file_index = 0;
        my $total_offset
            = int(
               (($index * $raw_data{refaddr $self}{q[info]}{q[piece length]}))
               + ($offset || 0));
    SEARCH:
        while ($total_offset > $files{refaddr $self}->[$file_index]->size) {
            $total_offset -= $files{refaddr $self}->[$file_index]->size;
            $file_index++;
            last SEARCH    # XXX - return?
                if not defined $files{refaddr $self}->[$file_index]->size;
        }
    WRITE: while (length $$data > 0) {
            my $this_write
                = ($total_offset + length $$data
                   > $files{refaddr $self}->[$file_index]->size)
                ? $files{refaddr $self}->[$file_index]->size - $total_offset
                : length $$data;
            $files{refaddr $self}->[$file_index]->_open(q[w]) or return;
            $files{refaddr $self}->[$file_index]->_sysseek($total_offset);
            $files{refaddr $self}->[$file_index]
                ->_write(substr($$data, 0, $this_write, q[]))
                or return;
            $file_index++;
            last WRITE
                if not defined $files{refaddr $self}->[$file_index];
            $total_offset = 0;
        }
        return 1;
    }

    sub _read_data {
        my ($self, $index, $offset, $length) = @_;
        return if !defined $index  || $index !~ m[^\d+$];
        return if !defined $offset || $offset !~ m[^\d+$];
        return if !defined $length || $length !~ m[^\d+$];
        my $data = q[];
        if (($length + (
                 ($raw_data{refaddr $self}{q[info]}{q[piece length]} * $index)
                 + $offset
             )
            ) > $size{refaddr $self}
            )
        {   carp q[Too much or bad offset data for this torrent];
            return;
        }
        my $file_index = 0;
        my $total_offset
            = int(
               (($index * $raw_data{refaddr $self}{q[info]}{q[piece length]}))
               + ($offset || 0));
    SEARCH:
        while ($total_offset > $files{refaddr $self}->[$file_index]->size) {
            $total_offset -= $files{refaddr $self}->[$file_index]->size;
            $file_index++;
            last SEARCH    # XXX - return?
                if not defined $files{refaddr $self}->[$file_index]->size;
        }
    READ: while ((defined $length) && ($length > 0)) {
            my $this_read
                = (($total_offset + $length)
                   >= $files{refaddr $self}->[$file_index]->size)
                ? ($files{refaddr $self}->[$file_index]->size - $total_offset)
                : $length;
            $files{refaddr $self}->[$file_index]->_open(q[r]) or return;
            $files{refaddr $self}->[$file_index]->_sysseek($total_offset);
            my $_data
                = $files{refaddr $self}->[$file_index]->_read($this_read);
            $data .= $_data if $_data;
            $file_index++;
            $length -= $this_read;
            last READ if not defined $files{refaddr $self}->[$file_index];
            $total_offset = 0;
        }
        return \$data;
    }

    sub _check_piece_by_index {
        my ($self, $index) = @_;
        if ((!defined $index) || ($index !~ m[^\d+$])) {
            carp q[Net::BitTorrent::Torrent->_check_piece_by_index( INDEX ) ]
                . q[requires an index.];
            return;
        }
        delete $_working_pieces{refaddr $self}{$index};
        my $data =
            $self->_read_data(
                  $index, 0,
                  ($index == ($self->piece_count - 1)
                   ? ($size{refaddr $self} % $raw_data{refaddr $self}{q[info]}
                      {q[piece length]})
                   : $raw_data{refaddr $self}{q[info]}{q[piece length]}
                  )
            );
        if ((!$data)
            or (sha1_hex($$data) ne substr(
                              unpack(
                                  q[H*],
                                  $raw_data{refaddr $self}{q[info]}{q[pieces]}
                              ),
                              $index * 40,
                              40
                )
            )
            )
        {   vec(${$bitfield{refaddr $self}}, $index, 1) = 0;
            $self->_event(q[piece_hash_fail],
                          {Torrent => $self, Index => $index});
            return 0;
        }
        if (vec(${$bitfield{refaddr $self}}, $index, 1) == 0) {
            vec(${$bitfield{refaddr $self}}, $index, 1) = 1;
            $self->_event(q[piece_hash_pass],
                          {Torrent => $self, Index => $index});
        }
        return 1;
    }

    # Methods | Private | DHT
    sub _dht_announce {
        my ($self) = @_;
        $_client{refaddr $self}->_schedule(
                                     {Time   => time + 120,
                                      Code   => sub { shift->_dht_announce },
                                      Object => $self
                                     }
        );
        return if !${$status{refaddr $self}} & STARTED;
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        return if $self->private;
        return if !$_client{refaddr $self}->_use_dht;
        $_client{refaddr $self}->_dht->_announce($self);
        $_client{refaddr $self}->_schedule(
            {   Time => time + 15,
                Code => sub {
                    my ($s) = @_;
                    $_client{refaddr $s}->_dht->_scrape($s)
                        if $_client{refaddr $s}->_use_dht;
                },
                Object => $self
            }
        );
    }

    sub _dht_scrape {
        my ($self) = @_;
        $_client{refaddr $self}->_schedule(
                                       {Time   => time + 60,
                                        Code   => sub { shift->_dht_scrape },
                                        Object => $self
                                       }
        );
        return if !(${$status{refaddr $self}} & STARTED);
        return if (${$status{refaddr $self}} & CHECKING);
        return if !(${$status{refaddr $self}} & QUEUED);
        return if $self->private;
        $_client{refaddr $self}->_dht->_scrape($self)
            if $_client{refaddr $self}->_use_dht;
    }

    # Methods | Public | Callback system
    sub on_event {
        my ($self, $type, $method) = @_;
        carp sprintf q[Unknown callback: %s], $type
            unless ___check_event($type);
        $_event{refaddr $self}{$type} = $method;
    }

    # Methods | Private | Callback system
    sub _event {
        my ($self, $type, $args) = @_;
        carp sprintf
            q[Unknown event: %s. This is a bug in Net::BitTorrent::Torrent; Report it.],
            $type
            unless ___check_event($type);
        $_client{refaddr $self}->_event($type, $args)
            if ${$status{refaddr $self}} & QUEUED;
        return $_event{refaddr $self}{$type}
            ? $_event{refaddr $self}{$type}($self, $args)
            : ();
    }

    # Functions | Private | Callback system
    sub ___check_event {
        my $type = shift;
        return scalar grep { $_ eq $type } qw[
            tracker_connect tracker_disconnect
            tracker_read    tracker_write
            tracker_success tracker_failure
            piece_hash_pass piece_hash_fail
            file_open       file_close
            file_read       file_write
            file_error
        ];
    }

    # Methods | Public | Alpha
    sub save_resume_data {
        my ($self, $file) = @_;
        $file ||= $resume_path{refaddr $self};
        return if !$file;    # Don't even bother without a file to write to

        # Make sure file handles are closed so we don't mess up 'mtime' times
        for my $_file (@{$files{refaddr $self}}) { $_file->_close }

        # Gather nodes from various sources
        #   Internal
        my $_nodes = $_nodes{refaddr $self};

        #   DHT
        $_nodes .= (((${$status{refaddr $self}} & QUEUED) && !$self->private)
                    ? $_client{refaddr $self}->_dht->_peers($self->infohash)
                    : q[]
        );

        #   Trackers
        for my $tier (@{$trackers{refaddr $self}}) {
            for my $url (@{$tier->urls}) { $_nodes .= $url->_peers; }
        }

        # The resume data proper
        my %resume_data = (
            q[.format]  => q[Net::BitTorrent resume],
            q[.t]       => time,
            q[.version] => 2,
            bitfield    => ${$bitfield{refaddr $self}},
            files       => [
                map {
                    {priority => $_->priority,
                     mtime    => (-f $_->path ? (stat($_->path))[9] : 0)
                    }
                    } @{$files{refaddr $self}}
            ],
            peers => ($_nodes ? $_nodes : q[]),
            working => [
                map {
                    {Block_Count => $_->{q[Block_Count]},
                     Endgame     => $_->{q[Endgame]},
                     Blocks_Received =>
                         pack(q[b*], join q[], @{$_->{q[Blocks_Received]}}),
                     Index             => $_->{q[Index]},
                     Slow              => $_->{q[Slow]},
                     Block_Length      => $_->{q[Block_Length]},
                     Block_Length_Last => $_->{q[Block_Length_Last]},
                     Length            => $_->{q[Length]},
                     Priority          => $_->{q[Priority]}
                    }
                    } values %{$_working_pieces{refaddr $self}}
            ]
        );

        # Write it to disk
        open(my ($_RD), q[>], $file) || return;
        syswrite($_RD, bencode(\%resume_data)) || return;
        return close $_RD;
    }

    # Methods | Public | Utility
    sub as_string {
        my ($self, $advanced) = @_;
        my $wanted = $self->_wanted;
        my $dump
            = !$advanced ? $self->infohash : sprintf <<'END',
Net::BitTorrent::Torrent
Path:            %s
Name:            %s
Infohash:        %s
Base Directory:  %s
Size:            %s bytes
Status:          %d (%s.)
DHT Status:      %s
Progress:        %3.2f%% complete (%d bytes up / %d bytes down)
[%s]
----------
Pieces: %d x %d bytes
Working: %s
%s
----------
 ...has %d file%s:
  %s
----------
 ...has %d tracker tier%s:
  %s
----------
END
            $self->path, $raw_data{refaddr $self}{q[info]}{q[name]},
            $self->infohash(), $_basedir{refaddr $self}, $size{refaddr $self},
            ${$status{refaddr $self}}, $self->_status_as_string(),
            ($self->private ? q[Disabled [Private]] : q[Enabled.]),
            100 - (grep {$_} split //,
                   unpack(q[b*], $wanted) / $self->piece_count * 100
            ),
            $uploaded{refaddr $self}, $downloaded{refaddr $self}, (
            sprintf q[%s],
            join q[],
            map {
                vec(${$bitfield{refaddr $self}}, $_, 1) ? q[|]    # have
                    : $_working_pieces{refaddr $self}{$_} ? q[*]  # working
                    : vec($wanted, $_, 1) ? q[ ]                  # missing
                    : q[x]                                        # don't want
                } 0 .. $self->piece_count - 1
            ),
            $self->piece_count(),
            $raw_data{refaddr $self}{q[info]}{q[piece length]},
            (scalar keys %{$_working_pieces{refaddr $self}} || q[N/A]), (
            join qq[\n],
            map {
                my $index = $_;
                sprintf q[%4d [%s] % 3.2f%%], $index, join(
                    q[],
                    map {
                        $_working_pieces{refaddr $self}{$index}
                            {q[Blocks_Received]}[$_] ? q[|]
                            : scalar
                            keys %{$_working_pieces{refaddr $self}{$index}
                                {q[Blocks_Requested]}[$_]} == 1 ? q[*]
                            : scalar
                            keys %{$_working_pieces{refaddr $self}{$index}
                                {q[Blocks_Requested]}[$_]} ? q[!]
                            : q[ ]
                        } 0 .. $_working_pieces{refaddr $self}{$index}
                        {q[Block_Count]} - 1
                    ),
                    (scalar(grep {$_}
                                @{
                                $_working_pieces{refaddr $self}{$index}
                                    {q[Blocks_Received]}
                                }
                         )
                         / $_working_pieces{refaddr $self}{$index}
                         {q[Block_Count]}
                    ) * 100;
                } sort { $a <=> $b }
                keys %{$_working_pieces{refaddr $self}}
            ),
            scalar @{$files{refaddr $self}},
            @{$files{refaddr $self}} != 1 ? q[s] : q[],
            join(qq[\n  ], map { $_->path } @{$files{refaddr $self}}),
            scalar @{$trackers{refaddr $self}},
            @{$trackers{refaddr $self}} != 1 ? q[s] : q[],
            join(qq[\n  ],
                 map     { $_->url }
                     map { @{$_->urls} } @{$trackers{refaddr $self}}
            );
        return defined wantarray ? $dump : print STDERR qq[$dump\n];
    }

    sub _status_as_string {
        my ($self) = @_;
        return ucfirst join q[, ],
            grep {$_}
            (${$status{refaddr $self}} & LOADED) ? q[was loaded okay] : q[],
            (${$status{refaddr $self}} & STARTED) ? q[is started]
            : q[is stopped],
            (${$status{refaddr $self}} & CHECKING)
            ? q[is currently hashchecking]
            : q[],
            (${$status{refaddr $self}} & START_AFTER_CHECK)
            ? q[needs hashchecking]
            : q[], (${$status{refaddr $self}} & CHECKED) ? q[has been checked]
            : q[has not been checked],
            (${$status{refaddr $self}} & PAUSED) ? q[has been paused] : q[],
            (${$status{refaddr $self}} & QUEUED) ? q[is queued]
            : q[is good for informational use only],
            (${$status{refaddr $self}} & ERROR) ? q[but has an error] : q[];
    }

    sub CLONE {
        for my $_oID (keys %REGISTRY) {
            my $_obj = $REGISTRY{$_oID};
            my $_nID = refaddr $_obj;
            for (@CONTENTS) {
                $_->{$_nID} = $_->{$_oID};
                delete $_->{$_oID};
            }
            weaken $_client{$_nID};
            weaken($REGISTRY{$_nID} = $_obj);
            delete $REGISTRY{$_oID};
        }
        return 1;
    }
    DESTROY {
        my ($self) = @_;
        for (@CONTENTS) { delete $_->{refaddr $self}; }
        return delete $REGISTRY{refaddr $self};
    }
    1;
}

=pod

=head1 NAME

Net::BitTorrent::Torrent - Class Representing a Single .torrent File

=head1 Synopsis

  use Net::BitTorrent::Torrent;

  my $torrent = Net::BitTorrent::Torrent->new({Path => q[a.legal.torrent]})
      or die q[Cannot load .torrent];

  $torrent->on_event(
      q[piece_hash_pass],
      sub {
          printf qq[%s is % 3.2f%% complete\r], $torrent->name,
              (scalar grep {$_} split q[], unpack q[b*], $torrent->bitfield)
              / $torrent->piece_count * 100;
      }
  );

  $torrent->hashcheck;    # Verify any existing data

=head1 Description

C objects are typically created by the
C class.

Standalone C objects can be made for
informational use.  See L and
L.

=head1 Constructor

=over

=item C

Creates a C object.  This constructor is
called by
Ladd_torrent( )|Net::BitTorrent/"add_torrent ( { ... } )">.

C accepts arguments as a hash, using key-value pairs:

=over

=item C

The root directory used to store the files related to this torrent.  This
directory is created if not preexisting.

This is an optional parameter.

Default: C<./> (Current working directory)

=item C

The L object this torrent will
eventually be served from.

This is an optional parameter.

No default.  Without a defined parent client, his object is very limited
in capability.  Basic information and L only.
Orphan objects are obviously not L automatically
and must be added to a client L.

=item C

Filename of the .torrent file to load.

This is the only required parameter.

=item C

The filename used to gather and store resume data.

This is an optional parameter.

No default.  Without a defined resume file, resume data will not be
written on calls to
L without a
C parameter.

=item C

Initial status of the torrent.  This parameter is ORed with the loaded
and queued (if applicable) values.

For example, you could set the torrent to automatically start after
L with
C<{ [...] Status =E START_AFTER_CHECK, [...] }>.

To import all supported statuses into your namespace, use the
C keyword.

This is an optional parameter.

Default: 1 (started)

See also: L

Note: This is alpha code and may not work correctly.

=back

=back

=head1 Methods

=over

=item C

Returns a bitfield representing the pieces that have been successfully
downloaded.

=item C

Returns the (optional) comment the original creator included in the
.torrent metadata.

=item C

Returns the (optional) "created by" string included in the .torrent
metadata. This is usually a software version.

=item C

Returns the (optional) creation time of the torrent, in standard UNIX
epoch format.

=item C

Returns the total amount downloaded from remote peers since the client
started transferring data related to this .torrent.

See also: L

=item C

Returns the most recent error that caused the software to set the
error L.  Torrents with active errors are
automatically stopped and must be L.

See also: L, L

=item C

Returns a list of
L objects
representing all files contained in the related .torrent file.

=item C

Verifies the integrity of all L
associated with this torrent.

This is a blocking method; all processing will stop until this function
returns.

See also: L, L

=item C

Returns the 20 byte SHA1 hash used to identify this torrent internally,
with trackers, and with remote peers.

=item C

Returns a bool value based on download progress.  Returns C when we
have completed every L with a
priority above C<0>.  Otherwise, returns C.

See also:
Lpriority()|Net::BitTorrent::Torrent::File/"priority( )">

=item C

Returns the advisory name used when creating the related files on disk.

In a single file torrent, this is used as the filename by default.  In a
multiple file torrent, this is used as the containing directory for
related files.

=item C

Net::BitTorrent::Torrent provides per-torrent callbacks.  For example,
to catch all attempts to read from a file, use
C<$torrent-Eon_event( 'file_read', \&on_read )>.  These per-
torrent callbacks are especially useful for standalone torrents.

See the L section for more.

=item C

Returns the L of the torrent this object represents.

=item C

Pauses an active torrent without closing related sockets.

See also: L, L,
L

=item C

Returns a list of remote L related to this
torrent.

=item C

The number of pieces this torrent's data is broken into.

=item C

Returns bool value dependent on whether the private flag is set in the
.torrent metadata.  Private torrents disallow information sharing via DHT
and PEX.

=item C

Adds a standalone (or orphan) torrent object to the particular
L object's queue.

See also:
L

=item C

Returns the bencoded metadata found in the .torrent file. This method
returns the original metadata in either bencoded form or as a raw hash
(if you have other plans for the data) depending on the boolean value of
the optional C parameter.

=item C

Returns the default path used to
L.  This value is set
in the C parameter to L.

=item C

One end of Net::BitTorrent's resume system.  This method writes the
data to the file specified in the call to L
or (if defined) to the C parameter.

See also:
L
and
L
in L

=item C

Returns the total size of all files listed in the .torrent file.

=item C

Returns the internal status of this C object.
States are bitwise C values of...

=begin html

  




1536




 





 





 





 





 





 



        




1537




 





 





 





 





 





 



          




1538




 





 





 





 





 





 



            




1539




 





 





 





 





 





 



             Value 




1540




 





 





 





 





 





 



            




1541




 





 





 





 





 





 



            




1542




 





 





 





 





 





 



             Type 




1543




 





 





 





 





 





 



            




1544




 





 





 





 





 





 



            




1545




 





 





 





 





 





 



             Notes 




1546




 





 





 





 





 





 



            




1547




 





 





 





 





 





 



          




1548




 





 





 





 





 





 



        




1549




 





 





 





 





 





 



        




1550




 





 





 





 





 





 



          




1551




 





 





 





 





 





 



            




1552




 





 





 





 





 





 



             1 




1553




 





 





 





 





 





 



            




1554




 





 





 





 





 





 



            




1555




 





 





 





 





 





 



             STARTED 




1556




 





 





 





 





 





 



            




1557




 





 





 





 





 





 



            




1558




 





 





 





 





 





 



             Client is (making an attempt to be) active in the swarm 




1559




 





 





 





 





 





 



            




1560




 





 





 





 





 





 



          




1561




 





 





 





 





 





 



          




1562




 





 





 





 





 





 



            




1563




 





 





 





 





 





 



             2 




1564




 





 





 





 





 





 



            




1565




 





 





 





 





 





 



            




1566




 





 





 





 





 





 



             CHECKING 




1567




 





 





 





 





 





 



            




1568




 





 





 





 





 





 



            




1569




 





 





 





 





 





 



             Currently hashchecking (possibly in another thread) 




1570




 





 





 





 





 





 



            




1571




 





 





 





 





 





 



          




1572




 





 





 





 





 





 



          




1573




 





 





 





 





 





 



            




1574




 





 





 





 





 





 



             4 




1575




 





 





 





 





 





 



            




1576




 





 





 





 





 





 



            




1577




 





 





 





 





 





 



             START_AFTER_CHECK 




1578




 





 





 





 





 





 



            




1579




 





 





 





 





 





 



            




1580




 





 





 





 





 





 



             (Unused in this version) 




1581




 





 





 





 





 





 



            




1582




 





 





 





 





 





 



          




1583




 





 





 





 





 





 



          




1584




 





 





 





 





 





 



            




1585




 





 





 





 





 





 



             8 




1586




 





 





 





 





 





 



            




1587




 





 





 





 





 





 



            




1588




 





 





 





 





 





 



             CHECKED 




1589




 





 





 





 





 





 



            




1590




 





 





 





 





 





 



            




1591




 





 





 





 





 





 



             Files of this torrent have been checked 




1592




 





 





 





 





 





 



            




1593




 





 





 





 





 





 



          




1594




 





 





 





 





 





 



          




1595




 





 





 





 





 





 



            




1596




 





 





 





 





 





 



             16 




1597




 





 





 





 





 





 



            




1598




 





 





 





 





 





 



            




1599




 





 





 





 





 





 



             ERROR 




1600




 





 





 





 





 





 



            




1601




 





 





 





 





 





 



            




1602




 





 





 





 





 





 



             Activity is halted and may require user intervention 




1603




 





 





 





 





 





 



             (Unused in this version) 




1604




 





 





 





 





 





 



            




1605




 





 





 





 





 





 



          




1606




 





 





 





 





 





 



          




1607




 





 





 





 





 





 



            




1608




 





 





 





 





 





 



             32 




1609




 





 





 





 





 





 



            




1610




 





 





 





 





 





 



            




1611




 





 





 





 





 





 



             PAUSED 




1612




 





 





 





 





 





 



            




1613




 





 





 





 





 





 



            




1614




 





 





 





 





 





 



             Sockets are kept open but no piece data is sent or requested 




1615




 





 





 





 





 





 



            




1616




 





 





 





 





 





 



          




1617




 





 





 





 





 





 



          




1618




 





 





 





 





 





 



            




1619




 





 





 





 





 





 



             64 




1620




 





 





 





 





 





 



            




1621




 





 





 





 





 





 



            




1622




 





 





 





 





 





 



             LOADED 




1623




 





 





 





 





 





 



            




1624




 





 





 





 





 





 



            




1625




 





 





 





 





 





 



             Torrent has been parsed without error 




1626




 





 





 





 





 





 



            




1627




 





 





 





 





 





 



          




1628




 





 





 





 





 





 



          




1629




 





 





 





 





 





 



            




1630




 





 





 





 





 





 



             128 




1631




 





 





 





 





 





 



            




1632




 





 





 





 





 





 



            




1633




 





 





 





 





 





 



             QUEUED 




1634




 





 





 





 





 





 



            




1635




 





 





 





 





 





 



            




1636




 





 





 





 





 





 



             Has an associated Net::BitTorrent parent 




1637




 





 





 





 





 





 



            




1638




 





 





 





 





 





 



          




1639




 





 





 





 





 





 



        




1640



            Value


            Type


            Notes






            1


            STARTED


            Client is (making an attempt to be) active in the swarm




            2


            CHECKING


            Currently hashchecking (possibly in another thread)




            4


            START_AFTER_CHECK


            (Unused in this version)




            8


            CHECKED


            Files of this torrent have been checked




            16


            ERROR


            Activity is halted and may require user intervention
            (Unused in this version)




            32


            PAUSED


            Sockets are kept open but no piece data is sent or requested




            64


            LOADED


            Torrent has been parsed without error




            128


            QUEUED


            Has an associated Net::BitTorrent parent





=end html

=begin :text,wiki

   1 = STARTED  (Client is (making an attempt to be) active in the swarm)
   2 = CHECKING (Currently hashchecking (possibly in another thread))
   4 = START_AFTER_CHECK*
   8 = CHECKED  (Files of this torrent have been checked)
  16 = ERROR    (Activity is halted and may require user intervention)
  32 = PAUSED   (Sockets are kept open but no piece data is sent or requested)
  64 = LOADED   (Torrent has been parsed without error)
 128 = QUEUED   (Has an associated Net::BitTorrent parent)

 * Currently unused

=end :text,wiki

For example, a status of C<201> implies the torrent is
C.

When torrents have the a status that indicates an error, they must be
L (if possible).  The reason for the error I
be returned by L.

Import the C<:status> tag and you'll get the various status keywords in
your namespace.

=begin :podcoverage

=over

=item STARTED

=item CHECKING

=item START_AFTER_CHECK

=item CHECKED

=item ERROR

=item PAUSED

=item LOADED

=item QUEUED

=back

=end :podcoverage

Note: This is alpha and may not work as advertised.  Yet.

=item C

Starts a paused or stopped torrent.

See also: L, L,
L

=item C

Stops an active or paused torrent.  All related sockets (peers) are
disconnected and all files are closed.

See also: L, L,
L

=item C

Returns a list of all
L
objects related to the torrent.

=item C

Returns the total amount uploaded to remote peers since the client
started transferring data related to this .torrent.

See also: L

=item C

Returns a 'ready to print' dump of the  object's data structure.  If
called in void context, the structure is printed to C.
C is a boolean value.

=back

=head1 Events

When triggered, per-torrent callbacks receive two arguments: the
C object and a hashref containing pertinent
information.  Per-torrent callbacks also trigger client-wide callbacks
when the current torrent is queued.

Per-torrent callbacks are limited to tracker-, piece-, and file-related
events.  See L for client-wide
callbacks.

=head1 Author

Sanko Robinson  - http://sankorobinson.com/

CPAN ID: SANKO

=head1 License and Legal

Copyright (C) 2008-2009 by Sanko Robinson [e-mail]

This program is free software; you can redistribute it and/or modify
it under the terms of The Artistic License 2.0.  See the F
file included with this distribution or
http://www.perlfoundation.org/artistic_license_2_0.  For
clarification, see http://www.perlfoundation.org/artistic_2_0_notes.

When separated from the distribution, all POD documentation is covered
by the Creative Commons Attribution-Share Alike 3.0 License.  See
http://creativecommons.org/licenses/by-sa/3.0/us/legalcode.  For
clarification, see http://creativecommons.org/licenses/by-sa/3.0/us/.

Neither this module nor the L is affiliated with
BitTorrent, Inc.

=for svn $Id: Torrent.pm 64e98b0 2009-09-12 05:23:14Z [e-mail] $

=cut