Commits

Toby Inkster committed 5fffd82

add whois command

  • Participants
  • Parent commits 4b7c103

Comments (0)

Files changed (3)

File lib/P5U/Command/Whois.pm

+package P5U::Command::Whois;
+
+use 5.010;
+use strict;
+use utf8;
+use P5U-command;
+
+BEGIN {
+	$P5U::Command::Whois::AUTHORITY = 'cpan:TOBYINK';
+	$P5U::Command::Whois::VERSION   = '0.001';
+};
+
+use constant {
+	abstract    => q[whois for CPAN authors],
+	usage_desc  => q[%c whois CPANID],
+};
+
+sub command_names {qw{ whois w }}
+
+sub opt_spec
+{
+	return (
+		[ 'verbose|v' => 'show extra information' ],
+	);
+}
+
+sub execute
+{
+	require P5U::Lib::Whois;
+	my ($self, $opt, $args) = @_;
+	
+	while (@$args)
+	{
+		print P5U::Lib::Whois
+			-> new(cpanid => shift @$args)
+			-> report($opt->{verbose});
+		print "\n" if @$args;
+	}
+}
+
+1;

File lib/P5U/Lib/Whois.pm

+package P5U::Lib::Whois;
+
+use Any::Moose; no warnings;
+use JSON qw(from_json);
+use LWP::Simple qw(get);
+use Object::AUTHORITY;
+
+use constant {
+	template_website           => 'https://metacpan.org/author/%s',
+	template_email             => '%s@cpan.org',
+	template_metacpan_data     => 'http://api.metacpan.org/v0/author/%s',
+	template_metacpan_releases => 'http://api.metacpan.org/v0/release/_search?q=author:%s+AND+status:latest&fields=name,date,abstract,status&size=5000',
+};
+
+has cpanid => (
+	is         => 'ro',
+	isa        => 'Str',
+);
+
+has metacpan_data => (
+	is         => 'ro',
+	isa        => 'HashRef',
+	lazy_build => 1,
+);
+
+sub _build_metacpan_data
+{
+	from_json get sprintf __PACKAGE__->template_metacpan_data, uc shift->cpanid
+}
+
+has metacpan_releases => (
+	is         => 'ro',
+	isa        => 'ArrayRef',
+	lazy_build => 1,
+);
+
+sub _build_metacpan_releases
+{
+	[
+		map { $_->{fields} }
+		@{
+			(from_json get sprintf __PACKAGE__->template_metacpan_releases, uc shift->cpanid)
+				->{hits}{hits}
+		}
+	]
+}
+
+has [qw(name city region country)] => (
+	is         => 'ro',
+	isa        => 'Str|Undef',
+	lazy_build => 1,
+);
+
+sub _build_name     { $_[0]->metacpan_data->{name} }
+sub _build_city     { $_[0]->metacpan_data->{city} }
+sub _build_region   { $_[0]->metacpan_data->{region} }
+sub _build_country  { $_[0]->metacpan_data->{country} }
+
+has [qw(latitude longitude)] => (
+	is         => 'ro',
+	isa        => 'Num|Undef',
+	lazy_build => 1,
+);
+
+sub _build_longitude { $_[0]->metacpan_data->{location}[0] }
+sub _build_latitude  { $_[0]->metacpan_data->{location}[1] }
+
+has [qw(website email)] => (
+	is         => 'ro',
+	isa        => 'ArrayRef[Str]',
+	lazy_build => 1,
+);
+
+sub _build_website
+{
+	my @r = @{ $_[0]->metacpan_data->{website} || [] };
+	@r = sprintf __PACKAGE__->template_website, uc shift->cpanid unless @r;
+	\@r
+}
+
+sub _build_email
+{
+	my @r = @{ $_[0]->metacpan_data->{email} || [] };
+	@r = sprintf __PACKAGE__->template_email, lc shift->cpanid unless @r;
+	\@r
+}
+
+sub location
+{
+	my $self = shift;
+	
+	my $addr = join q[, ], grep defined, map { $self->$_ } qw(city region country);
+	
+	if (defined $self->longitude and defined $self->latitude)
+	{
+		$addr .= sprintf(
+			" (%s, %s)",
+			$self->latitude,
+			$self->longitude,
+		)
+	}
+	
+	return $addr;
+}
+
+sub releases
+{
+	my $self = shift;
+	my @r =
+		sort
+		map  { $_->{name} }
+		@{ $self->metacpan_releases || [] };
+	wantarray ? @r : \@r
+}
+
+sub namespaces
+{
+	my $self = shift;
+	my %counts;
+	for ($self->releases)
+	{
+		next unless /^(.+?)-/;
+		$counts{$1}++;
+	}
+	my @r =
+		sort { $counts{$b} <=> $counts{$a} or $a cmp $b }
+		keys %counts;
+	wantarray ? @r : \@r
+}
+
+sub report
+{
+	my ($self, $detailed) = @_;
+	my $report = sprintf("%s (%s)\n", $self->name, uc $self->cpanid);
+	
+	my $location = $self->location;
+	$report .= "$location\n" if $location =~ /\w/;
+	
+	my $web = join q( ), map { "<$_>" } @{ $self->website };
+	$report .= "$web\n" if $web =~ /\w/;
+	
+	my $email = join q( ), map { "<mailto:$_>" } @{ $self->email };
+	$report .= "$email\n" if $email =~ /\w/;
+	
+	if ($detailed)
+	{
+		my @namespaces = $self->namespaces;
+		$report .= sprintf "\nNamespaces: %s\n" => join q(, ), @namespaces[0..9]
+			if @namespaces;
+			
+		my @recent =
+			map {
+				sprintf
+					'%s: %s - %s',
+					substr($_->{date}, 0, 10),
+					$_->{name},
+					$_->{abstract},
+			}
+			sort { $b->{date} cmp $a->{date} }
+			@{ $self->metacpan_releases || [] };
+		$report .= join "\n", q(), q(Recent:), @recent[0..9], q()
+			if @recent;
+		
+		if (@{ $self->metacpan_data->{profile} })
+		{
+			$report .= "\n";
+			for (sort { $a->{name} cmp $b->{name} } @{ $self->metacpan_data->{profile} })
+			{
+				$report .= sprintf(qq{%-16s%s\n}, @{$_}{qw{name id}})
+			}
+		}
+	}
+	
+	return $report;
+}
+
+1;
+
+
+
+__END__
+
+=head1 NAME
+
+P5U::Lib::Testers - support library implementing p5u's debian-release command
+
+=head1 SYNOPSIS
+
+ use P5U::Lib::Whois;
+ print P5U::Lib::Whois
+    -> new(cpanid => 'TOBYINK')
+    -> report;
+
+=head1 DESCRIPTION
+
+This is a support library for the testers command.
+
+It's an L<Any::Moose>-based class.
+
+=head2 Constructor
+
+=over
+
+=item C<< new(%attributes) >>
+
+Creates a new instance of the class.
+
+Generally speaking the only attribute you want to set here is C<cpanid>.
+
+=back
+
+=head2 Attributes
+
+=over
+
+=item C<cpanid>
+
+CPAN ID; read-only; string.
+
+=item C<name>
+
+Person's name; read-only; string or undef.
+
+=item C<city>
+
+City where person lives; read-only; string or undef.
+
+=item C<region>
+
+Region where person lives; read-only; string or undef.
+
+=item C<country>
+
+Country where person lives as an ISO 3166 code; read-only; string or undef.
+
+=item C<longitude>
+
+Longitude for where the person lives; read-only; number or undef.
+
+=item C<latitude>
+
+Latitude for where the person lives; read-only; number or undef.
+
+=item C<website>
+
+Person's websites; read-only, array ref of strings.
+
+=item C<email>
+
+Person's e-mail addresses; read-only, array ref of strings.
+
+=item C<metacpan_data>
+
+Data from MetaCPAN; read-only, hash ref.
+
+=item C<metacpan_releases>
+
+Release data from MetaCPAN; read-only, array ref.
+
+=back
+
+=head2 Methods
+
+=over
+
+=item C<location>
+
+Returns a string combining location data (city, region, country, co-ordinates).
+
+=item C<releases>
+
+Arrayref of strings of all latest releases. Strings are e.g. "Foo-Bar-0.001".
+
+=item C<namespaces>
+
+Top-level namespaces this person has released distributions in, sorted in order
+of most releases first.
+
+=item C<< report($detailed) >>
+
+Returns a whois report on the person as a long string. The parameter is a
+boolean indicating whether the report should include additional details.
+
+=back
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=P5U>.
+
+=head1 SEE ALSO
+
+L<p5u>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

File meta/changes.ttl

 	dcs:changeset [
 		dcs:versus dist:v_0-001 ;
 		dcs:item   [ rdfs:label "Lots and lots of documentation."@en; a dcs:Documentation ];
+		dcs:item   [ rdfs:label "'whois' command."@en; a dcs:Addition ];
 	].