#!/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
'; 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);