NOTE: The solution below is incorrect. Please refer to the latest attempt instead.

Here's my shot at it:

use List::Util qw(reduce);

my (@teams, %emp);
my $n = <>;

for my $i (0 .. $n - 1)
{
    my ($e1, $e2) = (split ' ', scalar <>);
    push @{ $emp{$e1} }, $i;
    push @{ $emp{$e2} }, $i;
    $teams[$i] = 1;
}

my @picks;
sub pick {
    my $pick = shift;
    push @picks, $pick;
    $teams[$_] = 0 for @{ $emp{$pick} };
    delete $emp{$pick};
}

my @favorites = (1002, 2001);
$emp{$_} and pick($_) for @favorites;

while (1)
{
    my $max =
      reduce { $a->[1] > $b->[1] ? $a : $b }
      map [ $_ => scalar(grep $teams[$_], @{ $emp{$_} }) ],
      keys %emp;

    my ($winner, $cnt) = @{ $max };
    last if $cnt == 0;
    pick($winner);
}

local $\ = "\n";
print scalar(@picks);
print for @picks;
[download]

Update: Now with favorites!