withyoujapan.pl

#!perl
use strict;
use Acme::CPANAuthors;
use File::Find;
use Getopt::Long;
use LWP::Simple;
use File::Temp qw(tempdir);
use Acme::CPANAuthors::Japanese;
use CPAN::DistnameInfo;
use Compress::Zlib;
use URI::Escape;

my $mirror = 'http://cpan.cpantesters.org';
GetOptions("mirror=s", \$mirror);

my $search  = generate_searcher($mirror);
my @modules = find_modules();

my %authors = Acme::CPANAuthors::Japanese->authors;
my(%found, $total);

my $done = 0;
for my $module (@modules) {
    my $dist = $search->($module) or next;

    if ($authors{$dist->cpanid}) {
        $found{$dist->cpanid}++;
        $total++;
    }
}

printf "You have %d modules installed in your \@INC developed by Japanese Perl hackers.\n", $total;
printf "It is %.1f%% of your entire perl libraries.\n\n", (100 * $total / @modules);

for my $author (sort { $found{$b} <=> $found{$a} } keys %found) {
    printf "%s: %s (%d)\n", $author, $authors{$author}, $found{$author};
}

my $tweet = sprintf "I have %d perl modules (%.1f%%) written by fellow Japanese perl hackers. How's yours? %s #japhcares", $total, (100 * $total / @modules), "https://gist.github.com/872012";

my $uri = "http://twitter.com/home/?status=" . URI::Escape::uri_escape($tweet);
system "open", $uri;

sub find_modules {
    my(%seen, @packlists);
    File::Find::find(sub { push @packlists, $File::Find::name if $_ eq '.packlist' }, @INC);
    return grep !$seen{$_}++, sort map packlist_to_name($_), @packlists;
}

sub generate_searcher {
    my $mirror = shift;
    my $file   = "02packages.details.txt";

    my $dir = tempdir(CLEANUP => 1);
    warn "Downloading $mirror/modules/$file.gz\n";
    LWP::Simple::mirror("$mirror/modules/$file.gz", "$dir/$file.gz") or die $!;

    my $gz = Compress::Zlib::gzopen("$dir/$file.gz", "rb") or die $!;
    my $body;
    while (my $st = $gz->gzread(my $buff)) {
        $body .= $buff;
    }

    return sub {
        my $module = shift;
        $body =~ m!^\Q$module\E\s+([\w\.]+)\s+(.*)!m
            and return CPAN::DistnameInfo->new($2);
        return;
    };
}

sub packlist_to_name {
    my $packlist = shift;
    $packlist =~ s!.*auto/(.*)/\.packlist!$1! or return;
    $packlist =~ s!/!::!g;
    return $packlist;
}