#!/usr/bin/env perl
# Ruokalistaparseri v1.5.4
# Copyright (c) 2007-2010 Timo Sirainen
# 2011-2013 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 = 0; # 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
PNA.fi on kolmannen osapuolen tarjoama palvelu. En voi taata ruokalistojen oikeellisuutta. Virallisen ruokalistan saat näkyviin siirtymällä ravintolan omille sivuille painamalla sen nimestä. Jos huomaat ruokalistassa virheen, nopeiten virhe saadaan pois näkyvistä kun lähetät minulle siitä sähköpostia: lamperi+pna@gmail.com
\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
\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 "