Sorting user's wishes in console

human_likes_comparator.pl

#!/usr/bin/env perl

use warnings;
use strict;

$| = 1;

my @data;
while (<>) {
    /\S/ or next;
    s/^\s*//s;
    s/\s*$//s;
    if (length $_ == 1) {
        $_ eq "." and last;
        $_ eq "-" and pop @data;

        next;
    };

    push @data, $_;
};

@data = sort { do_compare($b, $a) } @data;

print "$_\n" for @data;

my %cache;
sub do_compare {
    my ($x, $y) = @_;
    $x eq $y and return 0;
    my $res = cache_compare($x, $y);
    $res //= ask_compare($x, $y);
    $cache{$x}{$y} = $res;
    $cache{$y}{$x} = -$res;
    return $res;
};

sub cache_compare {
    my ($x, $y) = @_;

    my $res;
    $res = $cache{$x}{$y};
    return $res if defined $res;

    my @maybe;

    foreach my $z (keys %{ $cache{$x} }) {
        defined $cache{$z}{$y} or next;
        $cache{$x}{$z} * $cache{$z}{$y} >= 0 or next;
        push @maybe, $cache{$x}{$z}+$cache{$z}{$y};
    };
    foreach my $z (keys %{ $cache{$y} }) {
        defined $cache{$z}{$x} or next;
        $cache{$y}{$z} * $cache{$z}{$x} >= 0 or next;
        push @maybe, -$cache{$y}{$z}-$cache{$z}{$x};
    };
    return unless @maybe;

    @maybe = sort { $a <=> $b } @maybe;
    if ($maybe[0] == $maybe[-1] or $maybe[0]*$maybe[-1] > 0) {
        return $maybe[0];
    };
    warn "Comparison $x vs $y nontransitive!";

    return;
};

sub ask_compare {
    my ($x, $y) = @_;
    print STDERR "Which do you like more?\n";
    print STDERR "1) $x\n";
    print STDERR "2) $y\n";
    print STDERR "0) none\n";
    print STDERR "> ";
    my $res;
    while (<STDIN>) {
        /^\s*[012]\s*$/ or next;
        $res = $_;
        last;
    };
    die "User gave no comparison"
        unless defined $res;
    $res == 2 and $res = -1;
    return $res;
};