Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: 2011.07
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 82 lines (71 sloc) 2.262 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
#!/usr/bin/env perl
use strict;
use warnings;
binmode STDOUT, ':encoding(UTF-8)';
#use 5.010;
use utf8;

use Date::Simple qw(today ymd);

my %contrib;

my $last_release = shift;
$last_release = release_date_of_prev_month() if not defined $last_release;
my $nick_to_name = nick_to_name_from_CREDITS();
open my $c, '-|', 'git', 'log', "--since=$last_release", '--pretty=format:%an|%cn|%s'
    or die "Can't open pipe to git log: $!";
binmode $c, ':encoding(UTF-8)';
while (my $line = <$c>) {
    my ($author, $comitter, $msg) = split /\|/, $line, 3;
    $contrib{nick_to_name($author)}++;
    $contrib{nick_to_name($comitter)}++ if $comitter ne 'Rakudo Perl';
    while ($msg =~ /\(([^)]+)\)\+\+/g) {
        $contrib{nick_to_name($1)}++;
    }
    while ($msg =~ /([^\s()]+)\+\+/g) {
        $contrib{nick_to_name($1)}++;
    }
    while ($msg =~ /courtesy of:?\s*(\S.*)/gi) {
        $contrib{nick_to_name($1)}++;
    }
}
close $c or warn $!;

my @contrib = reverse sort { $contrib{$a} <=> $contrib{$b} } keys %contrib;

print "Contributors to Rakudo since the release on $last_release:\n";
print join(', ', @contrib), "\n";


sub release_date_of_prev_month {
    my $release_date;
    my $last_month = today();
    $last_month-- while $last_month->month == today->month;
    $release_date = ymd(
                        $last_month->year,
                        $last_month->month,
                        1,
                    );
    $release_date++ while $release_date->day_of_week != 2;
    $release_date += 14;
    $release_date++ while $release_date->day_of_week != 4;
    return $release_date;
}

sub nick_to_name_from_CREDITS {
    open my $f, '<:utf8', 'CREDITS' or die "Can't open file CREDITS for reading: $!";
    local $/ = '';
    my %nicks;
    while (my $para = <$f>) {
        my @nicks;
        my $name;
        for (split /\n/, $para) {
            if (/^N: (.*)/) {
                $name = $1;
            } elsif (/^U: (.*)/) {
                push @nicks, $1;
            }
        }
        if (defined $name) {
            $nicks{lc $_} = $name for @nicks;
        }
    }
    close $f;
    return \%nicks;
}

sub nick_to_name {
    my $nick = shift;
    return defined $nick_to_name->{lc $nick}? $nick_to_name->{lc $nick} : $nick;
}

Something went wrong with that request. Please try again.