commits/web-app/active-graph.cgi

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

use strict;
use Sys::Hostname;
require 'siteconfig';
use GD::Simple;

print "Content-type: image/png\n";
print "Cache-Control: post-check=3600,pre-check=43200\n";
print "Cache-Control: max-age=86400\n";
print "Expires: Mon, 01 Jan 2099 05:00:00 GMT\n";
print "\n";

my (%y, %x, %counts);
our $site;
my $prog  = "/dash/commits/web-api/commit-active-projects.php";
my $args;

my %data;
my %dates;
my @dates;
my %projects;
my @projects;
my $log;
my $_max;
my $_min;
my $theproject;

my $var = 'top|project|company';

$_ = $ENV{QUERY_STRING};
($args) = /((($var)=[A-Za-z0-9_.-]+&?)+)/;

$args =~ /project=([A-Za-z0-9_.-]+)/;
$theproject = $1;

query();
report( $theproject );

sub query {
    
    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?$args\r\n";
    
    select(STDOUT);
    while (<S>) {
        if (/^#/) {
            $log .= "$_<br>";
            next;
        }
	chomp;
	if( $_max && $_min ) {
		my ($project,$date,$count) = split /\t/;
		$data{$project}{$date} = $count;
		$dates{$date} = 1;
		$projects{$project} = 1;
	} else {
		$_min = $_ if $_max;
		$_max = $_ unless $_max;
	}
    }
}

sub report {
	my $project = shift;
	my $dt = $_min;
	while( $dt <= $_max ) {
		$dates{$dt} = 1;
		if( ($dt % 100) >= 12 ) {
			$dt = (int( $dt / 100 ) + 1) * 100 + 1;
		} else {
			$dt++;
		}
	}
	@dates = keys %dates;
	@projects = keys %projects;
	@dates = sort @dates;
	@projects = sort @projects;

	compute_activity( $project );

	# create a new image
	my @ys = split( /,/, $data{$project}{LINEDATA} );
	my $width = 8 * scalar( @ys );
	my $img = GD::Simple->new($width,20);
	$img->transparent();
	$img->clear();
	$img->fgcolor(100,100,100);
	$img->bgcolor(200,200,200);

	my $x = 0;
	foreach my $y ( @ys ) {
	  $img->rectangle( $x, 20-$y, $x+6, 20);
	  $x += 8;
	}

	# convert into png data
	print $img->png;
}        

sub compute_activity {
	my $project = shift;
	my @ys;

	# get the data array
	my $seenany = 0;
	foreach my $date ( @dates ) {
		if( $seenany || defined( $data{$project}{$date} ) ) {
			my $d = $data{$project}{$date};
			$d = 0 unless $d;
			push @ys, $d;
			$seenany = 1;
		}
	}
	my @xs = @ys;

	# scale data so that maximum is max bar height
	my @zs = scale( \@ys, 20.0 );

	# scale data so that median is mid-point bar height
	my $clip = max( \@ys );
	for( my $idx = 0; $idx < 4; $idx++ ) {
		my $avg = average( \@zs, \@xs );
		last if( $avg >= 7.0 && $avg <= 13.0 );
		$clip *= $avg / 10.0;
		@ys = clip( \@xs, $clip );
		@zs = scale( \@ys, 21.0 );
	}

	# ensure that non-zero values are different than zeros
	@zs = nonzero( \@zs, \@xs );

	$data{$project}{LINEDATA} = join( ",", @zs );
}

sub scale {
	my $ins = shift;
	my $maxout = shift;
	my @outs;
	my $maxin = 0;
	foreach my $v ( @$ins ) {
		$maxin = $v if $v > $maxin;
	}
	return @$ins unless $maxin;
	my $scale = $maxout / $maxin;
	foreach my $v ( @$ins ) {
		my $d = int( $v * $scale );
		push @outs, $d;
	}
	return @outs;
}

sub clip {
	my $ins = shift;
	my $max = shift;
	my @outs;
	foreach my $v ( @$ins ) {
		my $d = $v;
		$d = $max if $d > $max;
		push @outs, $d;
	}
	return @outs;
}

sub max {
	my $ins = shift;
	my $max = 0;
	foreach my $v ( @$ins ) {
		$max = $v if $v > $max;
	}
	return $max;
}

sub average {
	my $ins = shift;
	my $orig = shift;
	my $sum = 0;
	my $cnt = 0;
	for( my $i = 0; $i < @$ins; $i++ ) {
		my $v = $ins->[$i];
		my $v0 = $orig->[$i];
		if( $v0 ) {
			$sum += $v;
			$cnt++;
		}
	}
	return 0 unless $cnt;
	return $sum / $cnt;
}

sub nonzero {
	my $ins = shift;
	my $orig = shift;
	my @outs;
	for( my $i - 0; $i < @$ins; $i++ ) {
		my $v = $ins->[$i];
		my $v0 = $orig->[$i];
		$v = 2 if $v0 && !$v;
		$v = 1 if !$v0;
		push @outs, $v;
	}
	return @outs;
}