view release on metacpan or  search on metacpan

lib/Protocol/BitTorrent/Metainfo.pm  view on Meta::CPAN

		$self->{files} = \@files;
		$self->{piece_length} = $info->{info}->{'piece length'};
		$self->{pieces} = $info->{info}->{pieces};
		$self->{is_private} = $info->{info}->{private} if exists $info->{info}->{private};
	}
	return $self;
}

sub root_path {
	my $self = shift;
	if(@_) {
		$self->{root_path} = shift;
		return $self
	}
	return $self->{root_path};
}

=head2 infohash

Returns the infohash for this torrent. Defined as the 20-character SHA1
hash of the info data.

=cut

sub infohash {
	my $self = shift;
	return sha1(
		try {
			$self->bencode($self->file_info)
		} catch {
			require Data::Dumper;
			die "Invalid infohash data: $_ from " . Data::Dumper::Dumper($self->file_info) . "\n"
		}
	);
}

=head2 file_info

Returns or updates the info data (referred to as an 'info dictionary' in the spec).

=cut

sub file_info {
	my $self = shift;
	unless(exists $self->{info}) {
		$self->{info} = {
			'piece length'	=> $self->piece_length,
			'pieces'	=> $self->pieces,
		};
		$self->{info}->{private} = $self->is_private if $self->has_private_flag;
		if($self->files == 1) {
			my ($file) = $self->files;
			$self->{info}{name} = $file->{name};
			$self->{info}{length} = $file->{length};
		} else {
			$self->{info}{name} = $self->root_path;
			$self->{info}{files} = [];
			foreach my $file ($self->files) {
				push @{ $self->{info}{files} }, {
					'length' => $file->{length},
					'path' => [ split m{/}, $file->{name} ],
				}
			}
		}
	}
	return $self->{info};
}

=head2 peer_id

Returns the current peer ID. This is a 20-character string used to
differentiate peers connecting to a torrent.

Will generate a new peer ID if one has not already been assigned.

=cut

sub peer_id {
	my $self = shift;
	if(@_) {
		$self->{peer_id} = shift;
	}
	$self->{peer_id} = $self->generate_peer_id unless exists $self->{peer_id};
	return $self->{peer_id};
}

=head2 generate_peer_id_azureus

Generate a new peer ID using the Azureus style:

 -BT0001-980123456789

Takes the following parameters:

=over 4

=item * $type - the 2-character type, defaults to PB (for "L<Protocol::BitTorrent>").

=item * $version - the 4-character version code, should be numeric although this is not
enforced. Defaults to current package version with . characters stripped.

=item * $suffix - trailing string data to append to the peer ID, defaults to random
decimal digits.

=back

Example invocation:

 $torrent->generate_peer_id_azureus('XX', '0100', '0123148')

=cut

sub generate_peer_id_azureus {
	my $self = shift;
	my $type = shift || 'PB';
	my $version = shift;
	my $suffix = shift || '';

	(($version = $self->VERSION || '') =~ tr/\.//d) unless defined $version;
	$version = "0$version" while length $version < 4;
	my $peer_id = '-' . $type . $version . '-' . $suffix;