#!/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.
Jos huomaat ruokalistassa virheen, nopeiten asia korjaantuu 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 "