File Coverage

blib/lib/Debian/Snapshot.pm

Criterion	Covered	Total	%
statement	22	51	43.1
branch	0	6	0.0
condition			n/a
subroutine	8	14	57.1
pod	5	5	100.0
total	35	76	46.0

package Debian::Snapshot;
BEGIN {
  $Debian::Snapshot::VERSION = '0.003';
}
# ABSTRACT: interface to snapshot.debian.org

use Any::Moose;

use Debian::Snapshot::Package;
use JSON ();
use LWP::UserAgent;

has 'user_agent' => (
	is      => 'rw',
	isa     => 'LWP::UserAgent',
	lazy    => 1,
	builder => '_build_user_agent',
);

has 'url' => (
	is      => 'rw',
	isa     => 'Str',
	default => 'http://snapshot.debian.org',
);

sub _build_user_agent {
	my $ua = LWP::UserAgent->new;
	$ua->agent("Debian-Snapshot/$Debian::Snapshot::VERSION ");
	$ua->env_proxy;
	return $ua;
}

sub _get {
	my $self = shift;
	my $url  = shift;
	$url = $self->url . $url;

	my $response = $self->user_agent->get($url, @_);

	die $response->status_line unless $response->is_success;
	return $response->decoded_content;
}

sub _get_json {
	my $self = shift;
	my $json = $self->_get(@_);
	return JSON::decode_json($json);
}

sub binaries {
	my ($self, $name, $version) = @_;

	my $json = $self->_get_json("/mr/binary/$name/");

	my @binaries = map $self->package($_->{source}, $_->{version})
	                        ->binary($_->{name}, $_->{binary_version}),
	                   @{ $json->{result} };

	if (defined $version) {
		$version = qr/^\Q$version\E$/ unless ref($version) eq 'Regexp';
		@binaries = grep $_->binary_version =~ $version, @binaries;
	}

	return \@binaries;
}

sub file {
	my ($self, $hash) = @_;
	Debian::Snapshot::File->new(
		hash     => $hash,
		_service => $self,
	);
}

sub package {
	my ($self, $package, $version) = @_;
	return Debian::Snapshot::Package->new(
		_service => $self,
		package => $package,
		version => $version,
	);
}

sub packages {
	my ($self) = @_;

	my $json = $self->_get_json("/mr/package/");
	my @package = map $_->{package}, @{ $json->{result} };

	return \@package;
}

sub package_versions {
	my ($self, $package) = @_;

	my $json = $self->_get_json("/mr/package/$package/");
	my @versions = map $_->{version}, @{ $json->{result} };
	return \@versions;
}

no Any::Moose;
1;



=pod

=head1 NAME

Debian::Snapshot - interface to snapshot.debian.org

=head1 VERSION

version 0.003

=head1 SYNOPSIS

  use Debian::Snapshot;
  my $s = Debian::Snapshot->new;

  my $p = $s->package("package", "version"); # see Debian::Snapshot::Package
  my @package_names   = @{ $s->packages };
  my @source_versions = @{ $s->package_versions("source-package") };

  my @bs = @{ $s->binaries("binary") };      # see Debian::Snapshot::Binary

  my $f = $s->file($sha1hash);               # see Debian::Snapshot::File

=head1 DESCRIPTION

This module provides an interface to the snapshot.debian.org service.

=head1 ATTRIBUTES

=head2 url

URL used to contact the snapshot service.
Defaults to C.

=head2 user_agent

The L object used to query the server.

=head1 METHODS

=head2 binaries($name, $version?)

Returns an arrayref of L
objects for the binary package named C<$name>.

If the optional parameter C<$version> is present, only return binaries whose
binary version matches C<$version> which might be either a string or a regular
expression.

=head2 file($hash)

Returns a L object for the file
with the given C<$hash>.

=head2 package($package, $version)

Returns a L object for the
source package C<$package> version C<$version>.

=head2 packages

Returns an arrayref of source package names.

=head2 package_versions($package)

Returns an arrayref of versions for source package C<$package>.

=head1 SEE ALSO

L

=head1 AUTHOR

  Ansgar Burchardt

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by Ansgar Burchardt .

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__