Skip to content

Instantly share code, notes, and snippets.

@dgl
Created October 11, 2011 19:45
Show Gist options
  • Save dgl/1279181 to your computer and use it in GitHub Desktop.
Save dgl/1279181 to your computer and use it in GitHub Desktop.
acme's search_cpan.pl with threads
#!/usr/bin/perl
use strict;
use threads;
use threads::shared;
use warnings;
use 5.12.0;
use Archive::Peek::Libarchive;
use Parse::CPAN::Packages;
use Path::Class;
use Term::ANSIColor;
my $CPAN = shift || die "Must pass path to local CPAN mirror";
my $search = shift || die "Must pass regular expression to use";
my $packages
= Parse::CPAN::Packages->new("$CPAN/modules/02packages.details.txt.gz");
my $lines :shared;
my @distributions :shared
= map { $_->prefix }
sort { $a->distvname cmp $b->distvname }
grep {
!( $_->prefix =~ m{/(?:emb|syb|bio)?perl-\d}i
|| $_->prefix =~ m{/(?:parrot|ponie)-\d}i
|| $_->prefix =~ m{/(?:kurila)-\d}i
|| $_->prefix =~ m{/\bperl-?5\.004}i
|| $_->prefix =~ m{/\bperl_mlb\.zip}i )
} $packages->latest_distributions;
map $_->join, map threads->create(\&process), 1 .. 5;
sub process {
while(my $distribution_prefix = shift @distributions) {
my $archive = file( $CPAN, 'authors', 'id', $distribution_prefix );
eval {
my $peek = Archive::Peek::Libarchive->new( filename => $archive );
$peek->iterate(
sub {
my ( $filename, $contents ) = @_;
return unless $filename =~ /\.(pl|pm)$/;
my $key = $archive . ':' . $filename;
while ( $contents =~ /$search/g ) {
my $pos = pos($contents);
my $previous = rindex( $contents, "\n", $-[0] );
$previous = 1 + rindex( $contents, "\n", $previous - 1 )
if $previous > 0;
my $next = index( $contents, "\n", $+[0] );
$next = index( $contents, "\n", 1 + $next ) if $next > 0;
# Limit length of snippet, 200 bytes should be enough for anyone
if ( $next > $previous + 200 ) {
$previous
= $previous < $-[0] - 100
? $-[0] - 100
: $previous;
$next = $next > $+[0] + 100 ? $+[0] + 100 : $next;
}
my $snippet
= substr( $contents, $previous, $next - $previous );
$snippet
=~ s{$search}{color('black on_yellow') . $& . color('reset')}eg;
say '' if $lines++;
say color('bold green'), $key, color('reset');
say "$snippet";
}
}
);
};
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment