1-4 1-3 1-2
2-3 2-4 3-4

##</code><code>##

use strict;
use warnings;

use Data::Dumper;

my @matches;
my $nb_players = 6;
my @rounds;
exit(-1) unless get_matches( $nb_players, \@matches );
exit(-1) unless get_rounds( $nb_players, \@matches, " - ", \@rounds );

print Dumper(\@rounds);

sub get_matches
{
    my ( $nb_players, $ref_matches ) = @_;

    my $odd_nb_players = 0;
    $odd_nb_players = 1 if( $nb_players % 2 );

    $nb_players += 1 if( $odd_nb_players );

    for (my $left_player = 1; $left_player < $nb_players; $left_player += 1 )
    {
        for (my $right_player = ($left_player+1); $right_player <= $nb_players; $right_player += 1 )
        {
            push(@$ref_matches, {'left_player' => $left_player,
                                 'right_player' => $right_player,
                                 'diff' => $right_player - $left_player} );
        }
    }

    # replace not existing player with "bye" if group has an odd number of players
    map { $_->{'right_player'} = 'bye' if( $_->{'right_player'} == $nb_players ) } @$ref_matches if( $odd_nb_players );

    return 1;
}

sub get_rounds
{
    my ( $nb_players, $ref_matches, $sep, $ref_rounds ) = @_;

    # handle 'bye' as a real player
    $nb_players += 1 if( $nb_players % 2 );

    my $nb_matches_per_round = $nb_players / 2;
    my $nb_rounds = $nb_players - 1;

    my @matches_sorted_by_diff = sort { $b->{'diff'} <=> $a->{'diff'} } @$ref_matches;

    for( my $round_idx = 0; $round_idx < $nb_rounds; $round_idx += 1 )
    {
        my @players;
        my @forbidden_matches;
        my $found_idx;
        my $found_match;
        my $found_match_str;

        for( my $match_idx = 0; $match_idx < $nb_matches_per_round; $match_idx += 1 )
        {
            my $found;
            my $i = -1;
            for my $ref_match ( @matches_sorted_by_diff )
            {
                $i += 1;

                next if( ("$ref_match->{'left_player'}" ~~ @players) ||
                         ("$ref_match->{'right_player'}" ~~ @players) );

                my $match_str = $ref_match->{'left_player'} . $sep . $ref_match->{'right_player'};
                next if( $match_str ~~ @forbidden_matches );

                $found = 1;
                $found_idx = $i;
                $found_match = $ref_match;
                $found_match_str = $match_str;
                push(@players, "$ref_match->{'left_player'}", "$ref_match->{'right_player'}");
                splice(@matches_sorted_by_diff, $i, 1);
                push(@{ $ref_rounds->[$round_idx] },
                     $found_match_str);
                last;
            }

            unless( $found )
            {
                push(@forbidden_matches, $found_match_str);

                pop(@players);
                pop(@players);
                splice(@matches_sorted_by_diff, $found_idx, 0, $found_match);
                pop(@{ $ref_rounds->[$round_idx] });
                $match_idx -= 1;
                redo;
            }
        }
    }

    return 1;
}