\n";
foreach my $r (@restaurants) {
my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
my ($title2, $url, $lazy_allergies, $info_class) = @{$info_ref};
my @week_foods = @{$week_foods_ref};
if (defined($week_foods[$day]) || $day < 5) {
# Bio+Kliininen often have the same foods
next if (try_merge_bio_kliininen(\$title, $day));
if ($info_class ne $class) {
$class = $info_class;
print $fout "
\n";
}
$url =~ s/&/&/g;
print $fout "
\n";
if ($title =~ /Sodexo/ || !defined($week_foods[$day])) {
print $fout "
Ruokalistaa ei saatavilla.
";
next;
}
if ($week ne "" && $week != $max_week) {
if ($week > $max_week || ($week == 1 && $max_week == 52)) {
# early..
print $fout "
Viikon $week ruokalista:
";
} else {
print $fout "
Saatavilla vain viikon $week ruokalista.
";
next;
}
}
if (scalar(@{$week_foods[$day]}) == 0) {
print $fout "
Ei ruokatietoja päivälle.
";
next;
}
print $fout "
\n";
foreach my $food (@{$week_foods[$day]}) {
my $output = "";
my %total_allergies;
my %maybe_allergies;
my $part_count = 0;
foreach my $part (split("\n", $food)) {
next if ($part =~ /^(Peruna|Riisi) /); # who cares?
# fries: well, maybe we do care, but we don't care about allergy stuff
# and keep it in the same line as the previous food so as not to
# waste visible space
my $fries = ($part =~ /^(Tikkuperunat|Ranskalaiset perunat)/);
$part_count++;
# add missing () around allergies
$part =~ s/ (([MLGK]|VL|Ve|Veg|Hot)(,([MLGK]|VL|Ve|Veg|Hot|))+)$/ ($1)/;
if ($part =~ /^(.*) \(([^\)]+)\)$/) {
# fix allergy issues
my ($food, $allergy) = ($1, $2);
# standardization
$allergy =~ s/Kasvis/K/g;
$allergy =~ s/([MLGK]|VL)([MLGK]|VL)/$1,$2/g;
# spaces to commas
$allergy =~ s/saatavana[: ]+(.*)$/eriks: $1/;
$allergy =~ s/ +/,/g;
# remove double commas
$allergy =~ s/,+/,/g;
# eriks: standardization
$allergy =~ s/,?eriks:,?/, eriks: /g;
# remove extra commas/spaces from beginning/end
$allergy =~ s/^[, ]+//;
$allergy =~ s/[, ]+$//;
$part = "$food ($allergy)";
}
$output .= "
\n" if ($output ne "" && !$fries);
if ($part =~ /Saatavana myös: (.*)/) {
# standardize allergy stuff
my $alt = $1;
$alt =~ s/^\((.*)\)$/$1/;
$alt =~ s/[, ]+/,/g;
$alt =~ s/^,+//;
$alt =~ s/,+$//;
$part =~ s/\)[- ]*Saatavana myös:.*/, eriks: $alt)/;
$part =~ s/[- ]*Saatavana myös:.*/ (eriks: $alt)/;
}
if ($part =~ /^(.*)(\([^\)]+\))$/) {
my ($text, $allergy) = ($1, $2);
if ($fries) {
$output .= ", $text";
} else {
$output .= "$text $allergy";
}
$allergy =~ s/^\((.*)\)$/$1/;
$allergy =~ s/ *eriks: //;
my %this_allergies;
foreach my $a (split(/[, ]/, $allergy)) {
foreach my $al (@allergies) {
if ($a eq $al) {
$this_allergies{$a} = 1;
last;
}
}
}
# is M=L always correct? not at least in all restaurants..
#$this_allergies{"L"} = 1 if ($this_allergies{"M"});
$this_allergies{"VL"} = 1 if ($this_allergies{"L"});
foreach my $a (keys %this_allergies) {
$total_allergies{$a}++;
$maybe_allergies{$a}++;
}
if ($lazy_allergies =~ /M/) {
# L might mean M
if ($this_allergies{"L"} && !$this_allergies{"M"}) {
$maybe_allergies{"M"}++;
}
}
} else {
if ($lazy_allergies eq "all") {
# no allergy info, make everything maybe
foreach my $a (@allergies) {
$maybe_allergies{$a}++;
}
}
$output .= $part;
}
}
my $allergy_output = "";
foreach my $a (@allergies) {
if ($total_allergies{$a} == $part_count) {
if (!defined($eatable_food_numbers{$a})) {
$eatable_food_numbers{$a} = "";
} else {
$eatable_food_numbers{$a} .= ",";
}
$eatable_food_numbers{$a} .= $foodnum;
} elsif ($maybe_allergies{$a} == $part_count) {
if (!defined($maybe_eatable_food_numbers{$a})) {
$maybe_eatable_food_numbers{$a} = "";
} else {
$maybe_eatable_food_numbers{$a} .= ",";
}
$maybe_eatable_food_numbers{$a} .= $foodnum;
}
}
print $fout " - $output
\n";
$foodnum++;
}
print $fout "
\n";
}
}
# write allergy scripts
print $fout '';
print $fout '\n";
print $fout "
\n";
write_days_header($fout, -1, $last_day);
write_prefix_header($fout, $prefix, 0);
print $fout "