day 21, Perl

use strict;
use warnings;

my %Ingred;
my %Allerg;

# Read file:
while (<>) {
    my ($ingred_str, $allerg_str) = m#^(.*) \(contains (.*)\)$#;

    my @ings = split( " ", $ingred_str );
    foreach my $i (@ings) {
        $Ingred{$i}{num}++;
    }

    foreach my $a (split( /, /, $allerg_str )) {
        $Allerg{$a}{num}++;
        foreach my $i (@ings) {
            $Allerg{$a}{counts}{$i}++;
        }
    }
}

# Part 1:
my %poss;
foreach my $a (keys %Allerg) {
    foreach my $i (keys %{$Allerg{$a}{counts}}) {
        $poss{$i}{$a}++  if ($Allerg{$a}{counts}{$i} == $Allerg{$a}{num});
    }
}

my $part1 = 0;
$part1 += $Ingred{$_}{num} foreach (grep { !exists $poss{$_} } (keys %Ingred));

print "Part 1: $part1\n";

# Part 2 (day 16 deja vu):
my %ans_key;
my $solved = 0;
my $num_allerg = keys %Allerg;

while ($solved < $num_allerg) {
    foreach my $ingred (grep { keys %{$poss{$_}} == 1 } keys %poss) {
        my $allerg = (keys %{$poss{$ingred}})[0];

        $ans_key{$allerg} = $ingred;
        $solved++;
        delete $poss{$_}{$allerg}  foreach (keys %poss);
    }
}

print "Part 2: ", join( ',', map { $ans_key{$_} } sort keys %ans_key ), "\n";