#!/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
'; my $file_footer = "
Päivitetty ". strftime("%d.%m.%Y %H:%M:%S", localtime). " ". " / Palaute lamperi+pna\@gmail.com". " / Koodit täältä". " / Mikä on PNA?". "
\n
\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 "

$title

\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"; } } # 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 "
"; 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 ""; } print $fout "\n"; for (my $day = 0; $day <= $last_day; $day++) { print $fout "\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"; } else { print $fout "\n"; } } print $fout "\n"; } print $fout "
Päivä$title
".$day_names[$day]."
    \n"; foreach my $food (@{$week_foods[$day]}) { print $fout "
  • $food
  • "; } 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);