chorus.pl

#!/usr/bin/perl

if (scalar(@ARGV)<1) {
    print "usage: chorus.pl file\n";
    exit 0;
}

my ($file) = @ARGV;

my @lines = ();

open INPUT,"<",$file;
while (my $line = <INPUT>) {
    chomp($line);
    $line =~ s/\r$//g;
    push(@lines,$line);
}
close INPUT;

my $n = scalar(@lines);

my %matches = ();

for ($i=0;$i<$n;$i++) {
    for ($j=$i+1;$j<$n;$j++) {
        if ($lines[$i] eq $lines[$j]) {
            push(@{$matches{$i}},$j);
        }
    }
}

sub has_pair {
    my ($a,$b) = @_;
    my %m = map { $_ => 1 } @{$matches{$a}};
    return exists $m{$b};
}

sub find_blocks {
    my ($begin) = @_;
    my $end = $begin;
    my $begin2 = $begin;
    my $end2 = $end;
    my @m = @{$matches{$begin}};
    if (scalar(@m)>0) {
        $begin2 = $m[0];
        my $a = $begin+1;
        my $b = $m[0]+1;
        while (has_pair($a,$b)) {
            $a = $a + 1;
            $b = $b + 1;
        }
        $end = $a - 1;
        $end2 = $b - 1;
    }
    return ($begin,$end,$begin2,$end2);
}

$i = 0;
while ($i<$n) {
    my ($begin,$end,$begin2,$end2) = find_blocks($i);
    if ($begin != $end) {
        print ">$begin..$end $begin2..$end2\n";
        for ($j=$begin;$j<=$end;$j++) {
            print "| " . $lines[$j] . "\n";
        }
        print "<$begin..$end $begin2..$end2\n";
    } else {
        print $lines[$begin] . "\n";
    }
    $i = $end + 1;
}