#!/usr/bin/perl -w

# tag-stats - tag classification statistics
#
# This script displays statistics and data for tag classification based on
# Severity fields and their mapping to a E/W/I code.
#
# The verbose options (-v, -vv, -vvv) can be used to display a detailed list
# of which tags are assigned to each category.

use v5.20;
use warnings;
use utf8;
use autodie qw(opendir closedir);

BEGIN {
    my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
    if (not $LINTIAN_ROOT) {
        require Cwd;
        $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
    } else {
        chdir $LINTIAN_ROOT or die "Cannot chdir to $LINTIAN_ROOT: $!\n";
    }
}

my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};

use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Deb822Parser qw(read_dpkg_control);
use Lintian::Tag::Info;

my @severities = reverse qw(pedantic info warning error);
my @types = qw(E W I P);

my %stats;
my $num_tags = 0;
my $num_ok = 0;
my $percent = 0;

my $verbose = $ARGV[0] ? ($ARGV[0] =~ s/v/v/g) : 0;

opendir(my $checkdir, "$LINTIAN_ROOT/checks");
for my $check (readdir($checkdir)) {
    next unless $check =~ /\.desc$/;

    my @tags = read_dpkg_control("$LINTIAN_ROOT/checks/$check");
    my $desc = $tags[0];
    my @needs;
    if ($desc and exists $desc->{'needs-info'}) {
        @needs = split(/\s*,\s*/, $desc->{'needs-info'});
    }

    shift(@tags);

    foreach my $tag (@tags) {
        my $name = $tag->{tag};
        my $severity = $tag->{severity};

        $severity = 'unclassified' if not $severity;

        my $info = Lintian::Tag::Info->new($tag, $desc->{'check-script'},
            $desc->{'type'});
        my $code = $info->code;

        push(@{$stats{severity}{$severity}}, $name);
        push(@{$stats{type}{severity}{$code}{$severity}}, $name);

        for my $need (@needs) {
            $stats{needs}{$severity}{$need} = 1;
        }

        $num_tags++;
    }
}

closedir($checkdir);

print "Severity\n";
foreach my $s (@severities) {
    my $tags = $stats{severity}{$s};
    print "  $s: " . @{$tags} . "\n";
    print '    ' . join("\n    ", sort @{$tags}) . "\n" if $verbose >= 3;
}

foreach my $t (@types) {
    print "\nType $t Severity\n";
    foreach my $s (@severities) {
        if (my $tags = $stats{type}{severity}{$t}{$s}) {
            print "  $s: " . @{$tags} . "\n";
            print '    ' . join("\n    ", sort @{$tags}) . "\n"
              if $verbose >= 2;
        }
    }
}

print "\nCollections\n";
foreach my $s (@severities) {
    if (my $needs = $stats{needs}{$s}) {
        my $size = scalar keys %{$needs};
        my @list = sort keys %{$needs};
        print "  $s: $size\n";
        print '    ' . join("\n    ", @list) . "\n" if $verbose >= 2;
    }
}

if ($verbose >= 1 and exists $stats{severity}{unclassified}) {
    print "\nUnclassified tags\n";
    print '  ' . join("\n  ", @{$stats{severity}{unclassified}}) . "\n";
}

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et
