commits/web-api/commit-project-diversity-3.cgi

#!/usr/bin/perl
# Copyright (c) 2006 Eclipse Foundation, made available under EPL v1.0
# Contributors Ward Cunningham, Bjorn Freeman-Benson

use strict;

print "Content-type: text/plain\n\n";
my ($year) = `date` =~ /(\d\d\d\d)/;
my $log;
my $site = "www.eclipse.org";
my $prog_companies  = "projects/web-api/commit-companies.php";
my $prog_people = "projects/web-api/commit-projects-committers.php";

my %data;
my %companies;

	query_companies();
	query_people();
	report();

sub query_companies {
    
    my $sockaddr = 'S n a4 x8';
    my $AF_INET = 2;
    my $SOCK_STREAM = 1;
    chop(my $hostname = `hostname`);
    
    my ($name, $aliases, $proto) = getprotobyname('tcp');
    my ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
    my ($name, $aliases, $type, $len, $thataddr) = gethostbyname($site);
    
    my $this = pack($sockaddr, $AF_INET, 0,     $thisaddr);
    my $that = pack($sockaddr, $AF_INET, 80,    $thataddr);
    
    socket (S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
    bind(S, $this) || die "bind: $!";
    connect(S, $that) || die "connect: $!";
    
    select(S); 
    $| = 1; 
    print S "GET /$prog_companies\r\n";
    
    select(STDOUT);
    while (<S>) {
        if (/^#/) {
            $log .= "$_<br>";
            next;
        }
	chomp;
	my ($person,$name1,$name2) = split /\t/;
	$companies{$person} = $name1 . $name2;
    }
}

sub query_people {
    
    my $sockaddr = 'S n a4 x8';
    my $AF_INET = 2;
    my $SOCK_STREAM = 1;
    chop(my $hostname = `hostname`);
    
    my ($name, $aliases, $proto) = getprotobyname('tcp');
    my ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
    my ($name, $aliases, $type, $len, $thataddr) = gethostbyname($site);
    
    my $this = pack($sockaddr, $AF_INET, 0,     $thisaddr);
    my $that = pack($sockaddr, $AF_INET, 80,    $thataddr);
    
    socket (S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
    bind(S, $this) || die "bind: $!";
    connect(S, $that) || die "connect: $!";
    
    select(S); 
    $| = 1; 
    print S "GET /$prog_people\r\n";
    
    select(STDOUT);
    while (<S>) {
        if (/^#/) {
            $log .= "$_<br>";
            next;
        }
	chomp;
	my ($project,$person) = split /\t/;
	my $company = $companies{$person};
	$company = "unknown" unless $company;
	$data{$project}{$company}++;
    }
}

sub report {
  my @projects = keys %data;
  foreach my $project ( @projects ) {
	my @companies = keys %{$data{$project}};
	foreach my $company ( @companies ) {
		print "$company	$project	$year	" . $data{$project}{$company} . "\n";
	}
  }
}