#!/usr/bin/env perl
use 5.10.0;
use strict;
use warnings;

use Compiler::Lexer;
use Path::Class::Rule;
use MetaCPAN::Client;
use Term::Encoding  ();
use Term::ANSIColor 'colored';
use List::Util 'any';
use Try::Tiny;

use Getopt::Long;
use Pod::Usage;

my $order_by     = 'popularity'; # or 'diversity';
my $limit        = 5;
my @skip_modules = qw( lib strict warnings );
my @skip_authors = qw( );

GetOptions(
    'limit=i'            => \$limit,
    'order-by=s'         => \$order_by,
    'skip-modules=s{1,}' => \@skip_modules,
    'skip-authors=s{1,}' => \@skip_authors,
) or pod2usage();

my $love = '<3';
if (Term::Encoding::term_encoding() =~ /^utf-?8$/i) {
     binmode STDOUT, ':utf8';
     $love = "\x{2665}";
}

BEGIN {
    if ($^O =~ /Win32/) {
        require Win32::Console::ANSI;
        Win32::Console::ANSI->import;
    }
}

my $lexer = Compiler::Lexer->new;
my $iter  = Path::Class::Rule->new->skip_git->perl_file->iter(@ARGV);
my $cpan  = MetaCPAN::Client->new;
my (%used, %author);

# fetch the modules you use
while ( defined( my $file = $iter->() )) {
    my $modules = $lexer->get_used_modules( scalar $file->slurp );
    foreach my $mod (@$modules) {
        next if any { $mod->{name} eq $_ } @skip_modules;
        $used{ $mod->{name} }++;
    }
}

# fetch the modules' authors
local $| = 1;
foreach my $module (keys %used) {
    print "you used $module $used{$module} times!" . (' ' x 40) . "\r";

    my $id = try { $cpan->module($module)->author };
    next unless $id and not any { $id eq $_ } @skip_authors;

    no warnings 'uninitialized';
    $author{ $id }{diversity}++;
    $author{ $id }{popularity} += $used{$module};
    push @{ $author{ $id }{modules} }, $module;
}

# order and display authors' informationa
my @thanks = sort { $author{$b}{$order_by} <=> $author{$a}{$order_by} } keys %author;
foreach my $i ( 0 .. $limit ) {
    my $id = $thanks[$i] or last;
    my $current_author = $author{$id};

    say "\n" . colored(['bright_red'], $love)
      . " $id wrote $current_author->{diversity} module(s) ("
      . join( ',' => @{$current_author->{modules}} )
      . "), used $current_author->{popularity} time(s)";

    my $profile = try { $cpan->author($id) };
    next unless $profile;

    say 'Hey! How about ' . colored(['yellow'], 'thanking ' . $profile->name) . '? You can, for example:';
    foreach my $site (@{ $profile->profile // [] }) {
        if ($site->{name} eq 'gittip' or $site->{name} eq 'gratipay') {
            say " * give $id a small tip on Gratipay (" . colored(['bright_blue'], "https://gratipay.com/$site->{id}") . ')';
        }
        elsif ($site->{name} eq 'github') {
            say " * 'like' or 'follow' $id on Github (" . colored(['bright_blue'], "https://github.com/$site->{id}") . ')';
        }
        elsif ($site->{name} eq 'playperl' or $site->{name} eq 'questhub') {
            say " * upvote some of $id\'s quests on Questhub (" . colored(['bright_blue'], "https://questhub.io/player/$site->{id}") . ')';
        }
        elsif ($site->{name} eq 'twitter') {
            say " * give $id a shout-out on Twitter! (" . colored(['bright_blue'], "https://twitter.com/$site->{id}") . ')';
        }
        elsif ($site->{name} eq 'coderwall') {
            say " * endorse $id on Coderwall! (" . colored(['bright_blue'], "https://coderwall.com/$site->{id}") . ')';
        }
        elsif ($site->{name} eq 'ohloh') {
            say " * send kudos to $id on Open HUB (ex-Ohloh) (" . colored(['bright_blue'], "https://www.openhub.net/accounts/$site->{id}/kudos") . ')';
        }
    }
    say " * send $id a thank you email (" . colored(['bright_blue'], $profile->email->[0]) . ')';
}

say "\nEvery day is CPAN Day! :)";
__END__
=head1 NAME

cpanthanks - Thank your CPAN authors

=head1 SYNOPSIS

    cpanthanks [options] -- path [, path2, ...]

    Options:
        --limit NUMBER                     only shows top NUMBER entries (default: 5)
        --order-by popularity|diversity    order your results (default: popularity)
        --skip-modules LIST                skip modules (default: lib strict warnings)
        --skip-authors LIST                skip authors (default: none skipped)

    Usage Examples:

       cpanthanks --skip-authors MYCPANID --limit 3 -- some/path other/path
       cpanthanks --order-by=diversity -- my/project/path

=head1 OPTIONS

=over 4

=item B<--limit NUMBER>

only shows the top NUMBER entires. Defaults to 5.

=item B<--order-by TYPE>

order results by 'popularity' (authors from modules you used the most)
or 'diversity' (authors with the most modules used by you).

=item B<--skip-modules LIST>

skip modules/pragmas that you don't want to consider. By default
it skips 'lib', 'strict' and 'warnings';

=item B<--skip-authors LIST>

skip authors you don't want to consider. If you are a CPAN author
yourself, you should consider skipping yourself :)

=back

=head1 DESCRIPTION

This program will parse all perl files/modules from a given list of directories
to try and find module authors to thank for. If you can, please find the time
to thank every author whose module helped you in your projects/work :D

=head1 THANKS!

This tiny app would not be possible without the incredible developers who
wrote the modules that it depends on! So...

=over 4

=item Thank you B<Masaaki Goshima> for L<Compiler::Lexer>!

=item Thank you B<David Golden> for L<Path::Class::Rule>!

=item Thank you B<Mickey Nasriachi> and B<Sawyer> for L<MetaCPAN::Client>!

=item Thank you B<Tatsuhiko Miyagawa> and B<Audrey Tang> for L<Term::Encoding>!

=item Thank you B<Russ Allbery> for L<Term::ANSIColor>!

=item Thank you B<Jean-Louis Morel> for L<Win32::Console::ANSI>!

=item Thank you B<Graham Barr> and B<Paul Evans> for L<List::Util>!

=item Thank you B<Yuval Kogman> and B<Jesse Luehrs> for L<Try::Tiny>!

=item Thank you B<Johan Vromans> for L<Getopt::Long>!

=item Thank you B<Marek Rouchal> and B<Brad Appleton> for L<Pod::Usage>!

=back

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2014, Breno G. de Oliveira C<< <garu@cpan.org> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.


=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.