}
for my $name (keys %set_path) {
- my $allp = 1;
for my $path (@{$set_path{$name}}) {
if (defined $path && exists $iso{$path}) { delete $iso{$path}; }
- else { $allp = 0; }
}
- ##if ($allp) { delete $set_path{$name}; }
}
my @iso = sort keys %iso;
if ($box ne $lastbox) { print "!box $box\n"; $lastbox = $box; }
}
+sub path_key ($) {
+ my ($p) = @_;
+ if ($p =~ m{^ ([a-z]) / ([^/]+) ((?: / .*)?) $}ix) {
+ my $init = $1;
+ my $focus = $2;
+ my $tail = $3;
+ my $head = undef;
+ if ($focus =~ /^ (the | a ) \s+ (\S .*) $/x)
+ { $head = $1; $focus = $2; }
+ if (lc $init ne lc substr($focus, 0, 1) &&
+ $focus =~ /^ (.*) \s+ ($init .*) $/x)
+ { $head .= (defined $head && " ") . $1; $focus = $2; }
+ if (defined $head) { return "$init/$focus, $head$tail"; }
+ }
+ return $p;
+}
+
for my $name (sort { my $pa = $set_path{$a}[0]; my $ba = $box{$pa} // "~~~";
my $pb = $set_path{$b}[0]; my $bb = $box{$pb} // "~~~";
- $ba cmp $bb || $pa cmp $pb }
+ $ba cmp $bb || path_key $pa cmp path_key $pb }
keys %set_path) {
my $paths = $set_path{$name};
my @unk;
set_box $box{$paths->[0]};
- while (@iso && $iso[0] lt $paths->[0]) { push @unk, shift @iso; }
- if (@unk) {
- print "[#UNK: *]\n";
- for my $path (@unk) { print "\t", $path, "\n"; }
- }
printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
my $i = 0;
for my $path (@$paths) {