Sławomir Nizio
85 lines
1.6 KiB
Perl
Executable File
85 lines
1.6 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
# This code is licenced GPLv2 or newer.
|
|
|
|
use warnings;
|
|
use strict;
|
|
use 5.010;
|
|
|
|
my $g_thres = shift // 3;
|
|
|
|
sub set_atoms {
|
|
my %atoms = ();
|
|
my $fh = shift;
|
|
while (my $line = <$fh>) {
|
|
chomp $line;
|
|
my @words = split(' ', $line, 2);
|
|
next if $words[0] eq "??"; # allow "dangling" files
|
|
my $what = $words[1];
|
|
@words = split(m:/:, $what);
|
|
my $pkg;
|
|
if (@words >= 2) {
|
|
$pkg = join("/", @words[0..1]);
|
|
} else {
|
|
$pkg = $words[0]
|
|
}
|
|
$atoms{$pkg} = 1;
|
|
}
|
|
keys %atoms
|
|
}
|
|
|
|
sub num {
|
|
my $what = shift;
|
|
my @arr = @_;
|
|
my $num = 0;
|
|
for (@arr) {
|
|
$num++ if index($_, "$what-") == 0
|
|
}
|
|
$num
|
|
}
|
|
|
|
sub replace {
|
|
my $atom = shift;
|
|
my @arr = @_;
|
|
my @new_arr;
|
|
for my $item (@arr) {
|
|
if( index($item, $atom) == 0 ) {
|
|
1;
|
|
} else {
|
|
push @new_arr, $item;
|
|
}
|
|
}
|
|
push @new_arr, "$atom*";
|
|
@new_arr;
|
|
}
|
|
|
|
# try to make (a*, b, c*) from (a-1, a, a-2, b, c, c-1),
|
|
# for example, if numberOf(/^a-?/) >= $thres
|
|
sub do_reduce {
|
|
my $thres = shift;
|
|
my @atoms = @_;
|
|
my @processed_atoms = @atoms;
|
|
for my $atom (@atoms) {
|
|
@processed_atoms = replace($atom, @processed_atoms)
|
|
if (num($atom, @processed_atoms) >= $thres);
|
|
}
|
|
@processed_atoms
|
|
}
|
|
|
|
#my @atoms = set_atoms(*DATA);
|
|
my @atoms = set_atoms(*STDIN);
|
|
@atoms = do_reduce($g_thres, @atoms);
|
|
say join ",", sort @atoms;
|
|
|
|
__DATA__
|
|
M net-p2p/transmission-base/metadata.xml
|
|
M net-p2p/transmission-cli/metadata.xml
|
|
M net-p2p/transmission-daemon/metadata.xml
|
|
M net-p2p/transmission-gtk/metadata.xml
|
|
M net-p2p/transmission-qt4/metadata.xml
|
|
M net-p2p/transmission/metadata.xml
|
|
M cat/pkg-1
|
|
M cat/pkg-2
|
|
M cat/pkg
|
|
M net-p2p/nic
|
|
?? betr.pl
|