#!/usr/bin/env perl
# Ruokalistaparseri v1.5.3
# Copyright (c) 2007-2010 Timo Sirainen
# 2011-2012 Toni Fadjukoff
# This is Public Domain
use strict;
use POSIX qw(strftime mktime);
use HTML::TokeParser;
use HTML::Entities;
use vars qw(@day_names);
@day_names = ( "Maanantai", "Tiistai", "Keskiviikko", "Torstai",
"Perjantai", "Lauantai", "Sunnuntai" );
require 'amica.pl';
require 'sodexo.pl';
require 'juvenes.pl';
require 'pky.pl';
my @allergies = ( "M", "L", "VL", "G", "K", "Ve" );
my %allergy_descriptions = (
"M" => "Maidoton",
"L" => "Laktoositon",
"VL" => "Vähälaktoosinen",
"G" => "Gluteiiniton",
"K" => "Kasvis",
"Ve" => "Vegaani"
);
my $global_prefix = "";
my $use_old = 1; # 1 is good for testing, 0 for production system!
my @unordered;
my @l = localtime;
my $this_week = strftime("%V", @l);
push @unordered, get_juvenes_restaurants($use_old);
push @unordered, get_amica_restaurant($use_old);
push @unordered, get_sodexo_restaurants($use_old);
push @unordered, get_pky_restaurants($use_old, $l[6] == 0 || $l[6] == 6);
my $max_week = 0;
foreach my $r (@unordered) {
my $week = @{$r}[2];
$max_week = $week if ($week > $max_week || $week == 1);
}
if ($l[6] != 0 && $this_week != $max_week) {
# it's not sunday, don't force next week's menu yet
$max_week = $this_week;
}
my $stamp = time() - 3600*24*7;
my $max_week_daterange = "";
if ($max_week >= 1 && $max_week <= 52) {
# figure out the date range
for (;;) {
my $stamp_week = strftime("%V", localtime($stamp));
last if ($stamp_week == $max_week);
$stamp += 3600*24;
}
my @l1 = localtime($stamp);
my @l2 = localtime($stamp + 3600*24*6);
if ($l1[4] == $l2[4]) {
# same month
$max_week_daterange = $l1[3]."-".$l2[3].".".($l1[4]+1).".";
} else {
# different months
$max_week_daterange = $l1[3].".".($l1[4]+1)."-".$l2[3].".".($l2[4]+1).".";
}
$max_week_daterange = " ($max_week_daterange)"
}
my $file_header = '
Ruokalistat
\n\n";
sub find_last_day_with_foods {
my $restaurants_ref = shift;
my $last_day = 0;
foreach my $r (@${restaurants_ref}) {
my ($title, $open_hours, $week, $week_foods_ref) = @{$r};
my @week_foods = @{$week_foods_ref};
for (my $day = 0; $day < 7; $day++) {
if (defined($week_foods[$day])) {
$last_day = $day if ($day > $last_day);
}
}
}
return $last_day;
}
sub write_days_header {
my ($fout, $day, $last_day) = @_;
print $fout " ";
for (my $i = 0; $i <= $last_day; $i++) {
if ($i == $day) {
print $fout $day_names[$i]." ";
} else {
print $fout "".$day_names[$i]." ";
}
}
if ($day < 0) {
print $fout "Taulukko";
} else {
print $fout "Taulukko ";
}
print $fout " \n";
}
sub write_prefix_header {
my ($fout, $prefix, $day) = @_;
$day = "table" if ($day == 0);
print $fout "";
if ($prefix eq "") {
print $fout "Kaikki ";
} else {
print $fout "Kaikki ";
}
if ($prefix eq "tay/") {
print $fout "TaY ";
} else {
print $fout "TaY ";
}
if ($prefix eq "tays/") {
print $fout "TAYS ";
} else {
print $fout "TAYS ";
}
if ($prefix eq "tty/") {
print $fout "TTY ";
} else {
print $fout "TTY ";
}
print $fout " \n";
}
sub write_day {
my ($day, $header, $outfname, $last_day, $restaurants_ref, $prefix) = @_;
my @restaurants = @{$restaurants_ref};
open(my $fout, ">$outfname") || die ("Can't create file $outfname");
print $fout "$file_header$header \n";
# print weekday links
print $fout "\n";
write_days_header($fout, $day, $last_day);
print $fout " Näytä: ";
foreach my $a (@allergies) {
print $fout " ";
print $fout "$a ";
}
print $fout " \n";
write_prefix_header($fout, $prefix, $day+1);
print $fout "
\n";
# print foods
my $foodnum = 0;
my %eatable_food_numbers;
my %maybe_eatable_food_numbers;
my $class = "left";
print $fout "\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 (!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 "
$file_footer";
close $fout;
}
sub write_all_days {
my ($restaurants_ref, $prefix, $title) = @_;
my $last_day = find_last_day_with_foods($restaurants_ref);
for (my $day = 0; $day < 7; $day++) {
my $outfname = $prefix.($day+1).".html";
if ($day > $last_day) {
unlink($outfname);
next;
}
my $header = $day_names[$day]." - $title vko $max_week$max_week_daterange";
write_day($day, $header, $outfname, $last_day, $restaurants_ref, $prefix);
}
}
sub write_table {
my ($restaurants_ref, $prefix, $title) = @_;
my @restaurants = @{$restaurants_ref};
my $last_day = find_last_day_with_foods($restaurants_ref);
my $outfname = $prefix."table.html";
open(my $fout, ">$outfname") || die ("Can't create file $outfname");
my $header = "$title vko $max_week$max_week_daterange";
print $fout "$file_header$header \n";
print $fout "\n";
write_days_header($fout, -1, $last_day);
write_prefix_header($fout, $prefix, 0);
print $fout "
Päivä ";
foreach my $r (@restaurants) {
my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
my ($title2, $url) = @{$info_ref};
$url =~ s/&/ /g;
print $fout "$title ";
}
print $fout " \n";
for (my $day = 0; $day <= $last_day; $day++) {
print $fout "".$day_names[$day]." \n";
foreach my $r (@restaurants) {
my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
my @week_foods = @{$week_foods_ref};
if (defined($week_foods[$day]) && ($week eq "" || $week == $max_week)) {
print $fout "\n";
foreach my $food (@{$week_foods[$day]}) {
print $fout "$food ";
}
print $fout " \n";
} else {
print $fout " \n";
}
}
print $fout " \n";
}
print $fout "
$file_footer";
close $fout;
}
sub get_restaurants_sorted {
my @restaurants = @_;
my @out;
foreach my $r (@restaurants) {
push @out, $r if (@{@{$r}[4]}[3] eq "left");
}
foreach my $r (@restaurants) {
push @out, $r if (@{@{$r}[4]}[3] eq "right");
}
foreach my $r (@restaurants) {
my @e = @{@{$r}[4]};
push @out, $r if ($e[3] eq "middle" && $e[1] !~ /TAMK/);
}
foreach my $r (@restaurants) {
my @e = @{@{$r}[4]};
push @out, $r if ($e[3] eq "middle" && $e[1] =~ /TAMK/);
}
return @out;
}
sub get_restaurants_with_prefix {
my $prefix = shift;
my @out;
foreach my $r (@_) {
my $name = @{$r}[0];
if ($name =~ /^\($prefix\)/) {
push @out, $r;
}
}
return get_restaurants_sorted(@out);
}
my $tty_title = "TTY:n ruokalistat";
my @tty = get_restaurants_with_prefix("TTY", @unordered);
write_all_days(\@tty, "tty/", $tty_title);
write_table(\@tty, "tty/", $tty_title);
my $tay_title = "Tampereen yliopiston ruokalistat";
my @tay = get_restaurants_with_prefix("TaY", @unordered);
write_all_days(\@tay, "tay/", $tay_title);
write_table(\@tay, "tay/", $tay_title);
my $tays_title = "TAYS:n ruokalistat";
my @tays = get_restaurants_with_prefix("TAYS", @unordered);
write_all_days(\@tays, "tays/", $tays_title);
write_table(\@tays, "tays/", $tays_title);
foreach my $r (@unordered) {
if (@{$r}[0] =~ /^\(TaY\)/) {
@{@{$r}[4]}[3] = "left";
}
if (@{$r}[0] =~ /^\(TTY\)/) {
@{@{$r}[4]}[3] = "right";
}
if (@{$r}[0] =~ /^\(TAYS\)/) {
@{@{$r}[4]}[3] = "middle";
}
}
my $all_title = "Tampereen yliopistojen ruokalistat";
my @all_restaurants = get_restaurants_sorted(@unordered);
# move fusion kitchen last
my @fusion = splice(@all_restaurants, 1, 1);
splice(@all_restaurants, 4, 0, @fusion);
write_all_days(\@all_restaurants, "", $all_title);
write_table(\@all_restaurants, "", $all_title);