#!/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 , possibly many times, to specify the initial set. -except introduces a function to ignore, can iterate. -debug 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(@_)) }