#!/usr/bin/perl -w
use strict;
use XML::Parser;
#use Data::Dumper;
# command line arguments: shell globs for the files containing the info
# for the ms assemblyes and mono's
my $msglob = shift || 'ms*.xml';
my $monoglob = shift || 'mono*.xml';
# maintainers file
my $mfile = 'maintainers.xml';
my $curfile;
# positions in array refs
use constant MNAME => 0;
use constant MASSEMBLY => 1;
use constant MCLASS => 2;
use constant MAINTAINER => 0;
use constant PERCENT => 1;
use constant HASH => 2;
# we store all the data in some global hash tables
# $email => [$name, \%assembly, \%class]
my %maintainer;
# $name => [$maintainer, $percent, \%classes];
my %assembly;
# $name => [$maintainer, $percent, \%methods]
my %class;
# my parsing state machine
my @status;
# current maintainer, class and assembly pointers
my ($curm, $curc, $cura);
my $mono = 0;
my $namespace = '';
my %status_action = (
MAINTAINERS => sub {
my ($elem, %attrs) = @_;
malformed ($mfile, $elem, 'maintainers', \@status);
push @status, 'DUDE';
},
DUDE => sub {
my ($elem, %attrs) = @_;
malformed ($mfile, $elem, 'person', \@status);
foreach(qw(email name)) {die "$_ not included in person\n" unless defined $attrs{$_}}
$curm = $maintainer{$attrs{email}} = [$attrs{name}, {}, {}];
push @status, 'DUDE_CONTENT';
},
DUDE_CONTENT => sub {
my ($elem, %attrs) = @_;
malformed ($mfile, $elem, 'class|assembly', \@status);
if ($elem eq 'class') {
$curm->[MCLASS]->{$attrs{name}} = '';
} elsif ($elem eq 'assembly') {
$curm->[MASSEMBLY]->{$attrs{name}} = '';
}
push @status, 'DUDE_CONTENT';
},
ASSEMBLY => sub {
my ($elem, %attrs) = @_;
malformed ($curfile, $elem, 'assembly', \@status);
$namespace = '';
$cura = $assembly{$attrs{name}} = ['', 0, {}];
push @status, 'NAMESPACE';
},
NAMESPACE => sub {
my ($elem, %attrs) = @_;
malformed ($curfile, $elem, 'namespace', \@status);
$namespace = $attrs{name};
push @status, 'CLASS';
},
CLASS => sub {
my ($elem, %attrs) = @_;
malformed ($curfile, $elem, 'class|valueType|interface', \@status);
if ($elem eq 'class') {
my $name = $namespace ? $namespace.".".$attrs{name} : $attrs{name};
if ($mono) {
warn "mono implements non exisistent class $name\n"
if (!exists $class{$name});
$curc = $class{$name};
} else {
$curc = $class{$name} = ['', 0, {}];
}
$cura->[HASH]->{$name} = $mono;
push @status, 'METHOD';
} else {
push @status, 'METHOD';
}
},
METHOD => sub {
my ($elem, %attrs) = @_;
malformed ($curfile, $elem, 'method|field|valueType', \@status);
if ($elem eq 'method') {
my $name = $attrs{signature};
if ($mono) {
warn "mono implements non exisistent method $name\n"
if (!exists $curc->[HASH]->{$name});
}
$curc->[HASH]->{$name} = $mono;
push @status, 'METHOD';
} else {
push @status, 'METHOD';
}
},
);
my $parser = new XML::Parser (Handlers => {Start => \&handle_tag, End => \&end_tag});
# parse the maintainers info
if ($mfile) {
@status = 'MAINTAINERS';
$parser->parsefile($mfile);
#print Dumper(\%maintainer);
}
foreach (glob($msglob)) {
$curfile = $_;
@status = 'ASSEMBLY';
$mono = 0;
$parser->parsefile($_);
}
foreach (glob($monoglob)) {
$curfile = $_;
@status = 'ASSEMBLY';
$mono = 1;
$parser->parsefile($_);
}
create_stats();
create_html();
#print Dumper(\%assembly);
#print Dumper(\%class);
exit(0);
sub malformed {
my ($file, $elem, $match, $data) = @_;
unless ($elem =~ /^$match$/) {
$data = Dumper($data) if defined $data;
die "file $file malformed ($elem instead of $match) $data\n"
}
}
sub handle_tag {
my $parser = shift @_;
my $status = $status[-1];
die "status $status unknown" unless exists $status_action{$status};
$status_action{$status}->(@_);
}
sub end_tag {
my $last = pop @status;
# print STDERR "done with $last\n";
}
sub assign_maintainer {
my ($m, $from, $to, $type) = @_;
foreach (keys %$from) {
if (!exists $to->{$_}) {
warn "$m maintains unknown $type $_\n";
# fixup to avoid warnings
$to->{$_}->[MAINTAINER] = $m;
$to->{$_}->[PERCENT] = 0;
$to->{$_}->[HASH] = {};
} else {
warn "$to->{$_}->[MAINTAINER] already maintains $_ (now $m)\n" if $to->{$_}->[MAINTAINER];
$to->{$_}->[MAINTAINER] = $m;
}
}
}
sub completeness {
my $hash = shift @_;
my $total = keys %$hash;
my $done = 0;
map {$done += $_} values %$hash;
return 0 unless $total;
return int($done*100/$total);
}
sub create_stats {
# set maintainer field in assembly and class hashes
foreach my $m (sort keys %maintainer) {
assign_maintainer ($m, $maintainer{$m}->[MASSEMBLY], \%assembly, 'assembly');
assign_maintainer ($m, $maintainer{$m}->[MCLASS], \%class, 'class');
}
# assign completeness percent
foreach my $ass (values %assembly) {
$ass->[PERCENT] = completeness ($ass->[HASH]);
}
foreach my $class (values %class) {
$class->[PERCENT] = completeness ($class->[HASH]);
}
}
sub html_header {
my ($title) = @_;
return <<"EOF";
$title
$title
EOF
}
sub unimplemented ($) {
my ($c) = @_;
my $id = $c;
$id =~ tr/./-/;
return "$c";
}
sub create_html {
open(F, ">per-assembly.html") || die "Cannot open file: $!";
print F html_header("Mono - per-assembly stats");
print F "Assembly | Maintainer | Completion\n";
foreach my $ass (sort keys %assembly) {
print F "\t |
---|
", join(' | ', $ass, $assembly{$ass}->[MAINTAINER], $assembly{$ass}->[PERCENT]), "\n";
}
print F " |
\n";
print F "\n";
close(F);
# per maintainer info
open(F, ">per-maintainer.html") || die "Cannot open file: $!";
print F html_header("Mono - per-maintainer stats");
print F "Maintainer | Class | Completion\n";
foreach my $m (sort keys %maintainer) {
my @classes = sort keys %{$maintainer{$m}->[MCLASS]};
my $count = @classes;
foreach my $c (@classes) {
my $start = $count?"\t |
---|
$m | ":"\t |
";
$count = 0;
print F $start, join(' | ', $c, $class{$c}->[PERCENT]), "\n";
}
}
my @unmantained = sort grep {!$class{$_}->[MAINTAINER]} keys %class;
my $count = @unmantained;
foreach my $c (@unmantained) {
my $start = $count?"\t |
Unmantained | ":"\t |
";
$count = 0;
print F $start, join(' | ', $c, $class{$c}->[PERCENT]), "\n";
}
print F " |
\n";
print F "