root/util/func_refact.pl

#!/usr/bin/perl -w
use strict;

use Storable;
use Getopt::Long;
use YAML;

GetOptions \our %Conf, qw(help|h nodes|n=s initial=s@ debug=s except=s@);

if ($Conf{help}) {
    print <<'END';
  run with -n filename containing nodes data produced by --nodes
of graphfuncs.pl. Will print initial set sizes for all functions
by default, or use -initial <fname>, possibly many times, to
specify the initial set. -except <fname> introduces a function to
ignore, can iterate. -debug <fname> is a function to print more
information about as components are computed.
END
    exit 0;
}
 
our $nodes = YAML::LoadFile($Conf{nodes}) or
        die "can't load nodes data: $!";

our %ignoring;

$ignoring{$_} = 1 && print "Ignoring: $_\n" for (@{$Conf{except}});
                
if (+$Conf{initial}) {
        print "Initial set: " . join(' ', @{$Conf{initial}}) . "\n";
        doUnion (@{$Conf{initial}});
} else {
        print "CC sizes:\n";
        for (keys %$nodes) {
            print "$_: " . union({$_=>1}, $_) . "\n";
        }
}
exit 0;

sub doUnion {
        my %ccset = map { $_ => 1 } @_;
        union (\%ccset, $_) for keys %ccset;
        print "doUnion: initial set size is " . scalar(keys %ccset) . "\n";

        print "\nFinding candidates.\n\n";

        candidates(\%ccset);
        #while (my $new = candidates(\%ccset)) {
        #    union(\%ccset, $new);
        #}
}

sub union {
    my ($set, $new) = @_;
    my $oldsize = keys %$set;
    my $debug = $new eq ($Conf{debug}||="");

    return 0 if $ignoring{$new};

    my $size = scalar(keys %$set) - 1; # to force one run even if $new is in
    $set->{$new} = 1;
    while (scalar(keys %$set) > $size) {
        $size = keys %$set;
        for my $f (keys %$set) {
            for my $t (@{$nodes->{$f}}) {
                next if $set->{$t} or $ignoring{$t};
                print "unionising $new: adding $t on account of $f\n" if $Conf{verbose} or $Conf{debug} eq $new;
                $set->{$t} = 1;
            }
        }
    }
    #print ::Y({post=>{set=>$set, new=>$new}});
    print "union: while adding $new, entered with $oldsize, leaving with $size\n"
        if $Conf{verbose} or $Conf{debug} eq $new;
    return $size - $oldsize; # new member count
}

sub candidates {
    my %cands;
    my $ccset = shift;
    for my $cand (keys %$nodes) {
        #print "trying: $cand\n";
        next if exists $ccset->{$cand} or $ignoring{$cand};
        #print "passed: $cand\n";
        $cands{$cand} = [ scalar @{$nodes->{$cand}}, 
                         # total callees for func
          , union(Storable::dclone($ccset), $cand)];  # new contributions
        #print "$cand: totall $cands{$cand}[0] $cands{$cand}[1]\n";
    }

    # print ten best candidates
    print_cand($_, $cands{$_}) for
        sort {score(@{$cands{$b}}) <=> score(@{$cands{$a}})}
        keys %cands;

    # prompt the user
    # return list of newly selected functions
}

sub print_cand {
    my ($cand, $data) = @_;
    my ($total, $new) = @$data;
    printf "$cand: %s ($total total, $new new)\n", score($total, $new);
}

sub score {
    my ($total, $new) = @_;
    return 0 if $total == $new;
    ($total - $new) / $total;
}

#sub clone { Load(Dump($_[0])) }
sub ::Y { require YAML; YAML::Dump(@_) }
sub ::YY { require Carp; Carp::confess(::Y(@_)) }