use strict;
my @frau = qw /bl ge gr br sw rt/;
my @mann = qw /ge bl bl br sw rt/;
my $paar;

my %fr = map { $_, 1 } @frau;
my %ma = map { $_, 1 } @mann;
for (keys %ma) {
    $paar++ if exists $fr{$_};
}
print "Paare: $paar\n";

my @frau = qw /bl ge gr br sw rt/;
my @mann = qw /ge bl bl br sw rt/;
my %h = ();        # der kleine Helfer ;)
@h{@frau} = @mann; # slice
my $anz = grep{ $h{$_} eq $_  }keys %h;
print $anz;

$, = "\n"; $\ = "\n";
my @frau = qw /bl ge gr br sw rt Tina Pia Frauke/;
my @mann = qw /ge bl bl br sw rt/;
my @keinMann = ();
local $SIG{__WARN__} = sub{push @keinMann, $_};
my %h = ();
@h{@frau} = @mann;
my $anz = grep{ $h{$_} eq $_  }keys %h;
print "Paare: $anz", "Kein Mann bekommen haben:", @keinMann;

#!/usr/bin/perl
use strict;
use warnings;

my @frau = qw /bl ge gr br sw rt/;
my @mann = qw /ge bl bl br sw rt/;

my %people;
my @paare;

$people{$_}->{f}++ for(@frau);
$people{$_}->{m}++ for(@mann);

while(my($k,$v)=each(%people))
{ push(@paare,$k) if($v->{m} && $v->{f}); }

print "Paare:".join(',',@paare)."\n";