Initial commit of PNA site scripts.

.gitignore

@@ -0,0 +1 @@
+*.html

amica.pl

@@ -0,0 +1,242 @@
+use vars qw(@day_names);
+
+# erkkeri is gone - could remove a lot of this ugliness
+
+my $erkkeri_title = "(TTY) Amica Erkkeri";
+my @restaurant_info = (
+  [ "(TaY) Amica Minerva", "http://www.amica.fi/minerva", "", "middle" ]
+  #[ $erkkeri_title, "http://www.amica.fi/erkkeri", "", "left" ]
+);
+
+my ($parse_func, $day_id, $week, $erkkeri);
+my (@cur_day_foods, @week_foods);
+
+sub amica_parse_to_eof {
+}
+
+sub amica_finish_day {
+  push @week_foods, [@cur_day_foods];
+  @cur_day_foods = ();
+  $day_id = $day_id + 1;
+}
+
+sub utf8_to_8859 {
+  $_ = shift;
+
+  s/ä/ä/g;
+  s/ö/ö/g;
+  s/Ä/Ä/g;
+  s/Ö/Ö/g;
+  return $_;
+}
+
+sub amica_parse_line {
+  my $text = shift;
+  
+  $text =~ tr/\r\n\t/   /;
+  $text =~ s/( | )*$//;
+  $text =~ s/ *(\d+,\d+ *\/ *)?\d+,\d+ *$//;
+  $text =~ s/^( | )*//;
+  $text =~ s/( | )*$//;
+  $text =~ s/valinnan mukaan$//;
+  if ($text =~ /^(.*) \(([^\)]+)\)$/) {
+    my ($name, $allergy) = ($1, $2);
+    $name =~ s/( )*$//;
+    $allergy =~ s/\*veg\./ eriks: Ve/g;
+    $allergy =~ s/veg/Ve/gi;
+    $allergy =~ s/\*([A-Z]+)/ eriks: $1/;
+    return "$name ($allergy)\n";
+  } elsif ($text ne "") {
+    return "$text\n";
+  }
+  return "";
+}
+
+sub amica_parse_split {
+  my $text = shift;
+  
+  my $food = "";
+  for (;;) {
+    $i = index($text, ")");
+    last if ($i == -1);
+    
+    my $line = substr($text, 0, $i + 1);
+    $food .= amica_parse_line($line);
+    $text = substr($text, $i + 1);
+  }
+  $food .= amica_parse_line($text);
+  push @cur_day_foods, $food if ($food ne "");
+}
+
+sub amica_parse_more_food {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    my $text = utf8_to_8859($token->[1]);
+    my $next_day_name = $day_names[$day_id+1];
+    
+    if ($day_id < 6 && $text =~ /^$next_day_name\b/i) {
+      # day changed
+      amica_finish_day();
+    } else {
+      amica_parse_split($text);
+    }
+  } elsif ($token->[0] eq 'S' && $token->[1] eq 'h2') {
+    amica_finish_day();
+    $parse_func = \&amica_parse_to_eof;
+  }
+}
+
+sub amica_parse_first_day {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    for ($day_id = 0; $day_id < 7; $day_id++) {
+      my $dayname = $day_names[$i];
+      last if ($token->[1] =~ /^$dayname\b/i);
+    }
+    $day_id = 0 if ($day_id == 7);
+    $parse_func = \&amica_parse_more_food;
+  }
+}
+
+sub amica_parse_to_start {
+  my $token = shift;
+  
+  if ($token->[0] eq 'S' && $token->[1] eq 'p') {
+    $parse_func = \&amica_parse_first_day;
+  }
+}
+
+sub get_week {
+  my ($mday, $mon) = @_;
+
+  my @l = localtime;
+  my @l2 = (0, 0, 0, $mday, $mon-1, $l[5], 0, 0, -1);
+  @l = localtime(mktime(@l2));
+  return strftime("%V", @l);
+}
+
+sub amica_parse_date {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    my $text = $token->[1];
+    if ($text =~ /^(\d\d\d\d)-(\d?\d)-(\d?\d) /) {
+      my ($mday, $mon) = ($3, $2);
+      $week = get_week($mday, $mon);
+    }
+  } elsif ($token->[0] eq 'E' && $token->[1] eq 'h2') {
+    $parse_func = \&amica_parse_to_start;
+  }
+}
+
+sub amica_parse_to_date {
+  my $token = shift;
+  
+  if ($token->[0] eq 'S' && $token->[1] eq 'h2') {
+    my %attrs = %{$token->[2]};
+    if ($attrs{'id'} =~ /HeadingMenu/) {
+      $parse_func = \&amica_parse_date;
+    }
+  }
+}
+
+sub parse_amica {
+  my ($fname, $info_ref) = @_;
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
+  my $title = @{$info_ref}[0];
+  
+  $week = "";
+  $day_id = 0;
+  @cur_day_foods = ();
+  @week_foods = ();
+
+  $parse_func = \&amica_parse_to_date;
+  while (my $token = $p->get_token) {
+    &$parse_func($token);
+  }
+  return [ $title, "", $week, [ @week_foods ], $info_ref ];
+}
+
+sub parse_amica_get_finnish_url {
+  my ($fname) = @_;
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
+
+  my @l = localtime;
+  my $this_week = strftime("%V", @l);
+
+  my $state = 0;
+  my $last_url = "";
+  my $week = "";
+  while (my $token = $p->get_token) {
+    if ($token->[0] eq 'S' && $token->[1] eq 'meta') {
+      my %attrs = %{$token->[2]};
+      if ($attrs{'name'} eq "TITLE") {
+        if ($attrs{'content'} =~ /(\d+)\.(\d+)\.? *- *(\d+)\.(\d+)/) {
+          my ($mday, $mon) = ($1, $2);
+          $week = get_week($mday, $mon);
+        } elsif ($attrs{'content'} =~ /(\d+)\.? *- *(\d+)\.(\d+)/) {
+          my ($mday, $mon) = ($1, $3);
+          $week = get_week($mday, $mon);
+        }
+	return "" if ($attrs{'content'} !~ /English/i && $week == $this_week);
+      }
+    } elsif ($token->[0] eq 'S' && $token->[1] eq 'a') {
+      my %attrs = %{$token->[2]};
+      $last_url = $attrs{'href'};
+    } elsif ($token->[0] eq 'T' && $token->[1] =~ /^ruokalista (\d+)\.(\d+)\.? *- *(\d+)\.(\d+)/i) {
+      my ($mday, $mon) = ($1, $2);
+      $week = get_week($mday, $mon);
+      return $last_url if ($week == $this_week);
+    } elsif ($token->[0] eq 'T' && $token->[1] =~ /^ruokalista (\d+)\.? *- *(\d+)\.(\d+)/i) {
+      my ($mday, $mon) = ($1, $3);
+      $week = get_week($mday, $mon);
+      return $last_url if ($week == $this_week);
+    } elsif ($token->[0] eq 'T' && $token->[1] =~ /^ruokalista (viikko|vko) (\d+)/i) {
+      $week = $2;
+      return $last_url if ($week == $this_week);
+    }
+  }
+  return "";
+}
+
+sub parse_amica_url {
+  my ($fname) = @_;
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
+  
+  my $state = 0;
+  while (my $token = $p->get_token) {
+    if ($token->[0] eq 'S') {
+      my %attrs = %{$token->[2]};
+      if ($token->[1] eq 'td' && $attrs{'title'} eq 'Ruokalistat' && $state == 0) {
+	$state = 1;
+      } elsif ($token->[1] eq 'a' && $state == 1) {
+	return $attrs{'href'};
+      }
+    }
+  }
+  return "";
+}
+
+sub get_amica_restaurant {
+  my $use_old = shift;
+  my $count = 0;
+  my @restaurants = ();
+  foreach my $i (@restaurant_info) {
+    my @info = @{$i};
+    my $temp_fname = "amica$count.temp.html";
+    my $url = $info[1];
+    if (!-f $temp_fname || !$use_old) {
+      system("wget -q --timeout=10 -O $temp_fname.tmp '$url' && mv $temp_fname.tmp $temp_fname") if ($url ne "");
+    }
+    if (-f $temp_fname) {
+      $info[1] = $url;
+      push @restaurants, parse_amica($temp_fname, \@info);
+    }
+    $count++;
+  }
+  return @restaurants;
+}
+
+1;

food.pl

@@ -0,0 +1,467 @@
+#!/usr/bin/env perl
+
+# Ruokalistaparseri v1.5.1
+# Copyright (c) 2007-2010 Timo Sirainen
+# 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 = '<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="fi" lang="fi">
+<head>
+  <title>Ruokalistat</title>
+  <link rel="stylesheet" type="text/css" href="'.$global_prefix.'/ruoka.css" />
+</head>
+<body onload="set_allergies()">
+
+
+<form method="get" action="/cgi-bin/food.cgi">
+';
+my $file_footer = "<div class=\"footer\">Päivitetty ".
+    strftime("%d.%m.%Y %H:%M:%S", localtime).
+    " <input type=\"submit\" value=\"Päivitä nyt\" />".
+    " / Palaute <a href=\"mailto:lamperi+pna\@gmail.com\">lamperi+pna\@gmail.com</a>".
+    " / <a href=\"$global_prefix/code.html\">Koodit täältä</a>".
+    " / <a href=\"$global_prefix/pna.html\">Mikä on PNA?</a>".
+    "</div>\n</form>\n</body></html>\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 "  <span class=\"days\">";
+  for (my $i = 0; $i <= $last_day; $i++) {
+    if ($i == $day) {
+      print $fout $day_names[$i]." ";
+    } else {
+      print $fout "<a href=\"".($i+1).".html\">".$day_names[$i]."</a> ";
+    }
+  }
+  if ($day < 0) {
+    print $fout "Taulukko";
+  } else {
+    print $fout "<a href=\"table.html\">Taulukko</a>";
+  }
+  print $fout "</span>\n";
+}
+
+sub write_prefix_header {
+  my ($fout, $prefix, $day) = @_;
+  
+  $day = "table" if ($day == 0);
+  print $fout "<span class=\"location\">";
+  if ($prefix eq "") {
+    print $fout "Kaikki ";
+  } else {
+    print $fout "<a href=\"$global_prefix/$day.html\">Kaikki</a> ";
+  }
+  if ($prefix eq "tay/") {
+    print $fout "TaY ";
+  } else {
+    print $fout "<a href=\"$global_prefix/tay/$day.html\">TaY</a> ";
+  }
+  if ($prefix eq "tays/") {
+    print $fout "TAYS ";
+  } else {
+    print $fout "<a href=\"$global_prefix/tays/$day.html\">TAYS</a> ";
+  }
+  if ($prefix eq "tty/") {
+    print $fout "TTY ";
+  } else {
+    print $fout "<a href=\"$global_prefix/tty/$day.html\">TTY</a> ";
+  }
+  print $fout "</span>\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<h1>$header</h1>\n";
+  # print weekday links
+  print $fout "<div class=\"title\">\n";
+  write_days_header($fout, $day, $last_day);
+  print $fout "  <span class=\"allergy\">Näytä: ";
+  foreach my $a (@allergies) {
+    print $fout "<input type=\"checkbox\" name=\"allergy_$a\" id=\"allergy_$a\" onclick=\"highlight()\" />";
+    print $fout "<span title=\"".$allergy_descriptions{$a}."\">$a</span>";
+  }
+  print $fout "</span>\n";
+  write_prefix_header($fout, $prefix, $day+1);
+  print $fout "</div>\n";
+
+  # print foods
+  my $foodnum = 0;
+  my %eatable_food_numbers;
+  my %maybe_eatable_food_numbers;
+  my $class = "left";
+  print $fout "<div class=\"foods\"><div class=\"$class\">\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 "</div><div class=\"$class\">\n";
+      }
+      $url =~ s/&/&amp;/g;
+      print $fout "<h2><a href=\"$url\">$title</a></h2>\n";
+      
+      if ($title =~ /Sodexo/ || !defined($week_foods[$day])) {
+	print $fout "<p class=\"missing\">Ruokalistaa ei saatavilla.</p>";
+	next;
+      }
+      if ($week ne "" && $week != $max_week) {
+	if ($week > $max_week || ($week == 1 && $max_week == 52)) {
+	  # early..
+	  print $fout "<p class=\"nextweek\">Viikon $week ruokalista:</p>";
+	} else {
+	  print $fout "<p class=\"missing\">Saatavilla vain viikon $week ruokalista.</p>";
+	  next;
+	}
+      }
+      if (scalar(@{$week_foods[$day]}) == 0) {
+	print $fout "<p class=\"missing\">Ei ruokatietoja päivälle.</p>";
+	next;
+      }
+      
+      print $fout "<ul class=\"food\">\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 .= "<br />\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 <span class=\"allergy\">$allergy</span>";
+	    }
+	    $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 "  <li id=\"f$foodnum\">$output</li>\n";
+	$foodnum++;
+      }
+      print $fout "</ul>\n";
+    }
+  }
+  # write allergy scripts
+  print $fout '<script type="text/javascript" src="'.$global_prefix.'/ruoka.js"></script>';
+  print $fout '<script type="text/javascript">';
+  print $fout "var eatable_foods = [];";
+  print $fout "var maybe_eatable_foods = [];";
+  foreach my $a (@allergies) {
+    print $fout "eatable_foods[\"$a\"] = [".$eatable_food_numbers{$a}."];\n";
+    print $fout "maybe_eatable_foods[\"$a\"] = [".$maybe_eatable_food_numbers{$a}."];\n";
+  }
+  my @allergy_strings = map('"'.$_.'"', @allergies);
+  print $fout "var allergies = [".join(",", @allergy_strings)."];\n";
+  print $fout "var food_count = $foodnum\n";
+  print $fout "</script>\n";
+
+  print $fout "</div></div>$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<h1>$header</h1>\n";
+  print $fout "<div class=\"title\">\n";
+  write_days_header($fout, -1, $last_day);
+  write_prefix_header($fout, $prefix, 0);
+  print $fout "</div><table border=\"1\"><tr><th>Päivä</th>";
+  foreach my $r (@restaurants) {
+    my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
+    my ($title2, $url) = @{$info_ref};
+    $url =~ s/&/&nbsp;/g;
+    print $fout "<th><a href=\"$url\">$title</a></th>";
+  }
+  print $fout "</tr>\n";
+  for (my $day = 0; $day <= $last_day; $day++) {
+    print $fout "<tr><td>".$day_names[$day]."</td>\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 "<td><ul>\n";
+	foreach my $food (@{$week_foods[$day]}) {
+	  print $fout "<li>$food</li>";
+	}
+	print $fout "</ul></td>\n";
+      } else {
+	print $fout "<td></td>\n";
+      }
+    }
+    print $fout "</tr>\n";
+  }
+  print $fout "</table>$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);

juvenes.pl

@@ -0,0 +1,220 @@
+use vars qw(@day_names);
+
+my $pinni_title = "(TaY) Café Pinni";
+my $bio_title = "(TAYS) Bio";
+my $kliininen_title = "(TAYS) Arvo";
+my $kliininen_fusion_title = "(TAYS) Arvo Fusion Kitchen";
+my $zip_salaattibaari_title = "(TTY) Zip Salaattibaari";
+my @restaurant_info = (
+  [ "(TaY) Yliopiston Ravintola", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Yliopiston_Ravintola", "M", "left" ],
+  [ "(TaY) Yliopiston Ravintola / Salaattibaari", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Yliopiston_Ravintola/Salaattibaari", "", "left" ],
+  [ "(TaY) Fusion Kitchen", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Yliopiston_Ravintola/Fusion_Kitchen", "", "left" ],
+  [ $pinni_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Caf__Pinni", "M", "middle" ],
+  [ $bio_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY_Kauppi__Medica_Bio", "M", "left" ],
+  [ $kliininen_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY_Kauppi__Medica_Arvo", "M", "left" ],
+  [ $kliininen_fusion_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY_Kauppi__Medica_Arvo/Fusion_Kitchen", "M", "left" ],
+  [ "(TTY) Newton", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Newton", "", "left" ],
+  [ "(TTY) Zip", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Zip", "", "right" ],
+  [ "(TTY) Edison", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Edison", "", "middle" ],
+  [ $zip_salaattibaari_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Zip/Salaattibaari", "", "right" ],
+  [ "(TTY) Pastabaari", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Caf____Fast_Voltti/Pastabaari", "", "middle" ],
+  [ "(TTY) Fast Voltti", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Caf____Fast_Voltti", "", "middle" ],
+  [ "(TTY) Fusion Kitchen", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Newton/Fusion_Kitchen", "", "left" ],
+  [ "(TAMK) Dot", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TAMK__Dot__Ziberia_", "", "middle" ]
+);
+
+my @restaurants;
+my ($parse_func, $week, $open_hours, $day_id, $cur_title);
+my ($cur_food, @cur_day_foods, @week_foods);
+
+sub parse_to_eof {
+}
+
+sub parse_skip_to_end_of_div {
+  my $token = shift;
+  
+  if ($token->[0] eq 'E' && $token->[1] eq 'div') {
+    $parse_func = \&parse_more_food;
+  }
+}
+
+sub parse_open_hours_begin {
+  my $token = shift;
+
+  if ($token->[0] eq 'T') {
+    if ($token->[1] =~ /^Aukiolo/) {
+      $parse_func = \&parse_open_hours_end;
+    }
+  }
+}
+
+sub parse_open_hours_end {
+  my $token = shift;
+
+  if ($token->[0] eq 'T') {
+    my $text = $token->[1];
+    if ($text eq 'Erityisruokavaliot') {
+      $parse_func = \&parse_to_eof;
+    } else {
+      $text =~ s/\n//g;
+      $text =~ s/ +$//;
+      $open_hours .= "$text\n" if ($text ne "");
+    }
+  }
+}
+
+sub finish_food {
+  chomp $cur_food;
+  if ($cur_food =~ /Liha paniini.*tai Kasvis paniini/i && $cur_title eq $pinni_title) {
+    # you get this every day, ignore
+  } else {
+    push @cur_day_foods, $cur_food if ($cur_food ne "");
+  }
+  $cur_food = "";
+}
+
+sub finish_day {
+  push @week_foods, [@cur_day_foods];
+  @cur_day_foods = ();
+  $day_id = $day_id + 1;
+}
+
+sub parse_more_food {
+  my $token = shift;
+  
+  if ($token->[0] eq 'S') {
+    my %attrs = %{$token->[2]};
+    if ($token->[1] eq 'div') {
+      if ($attrs{'style'} =~ /display: *none/) {
+	# infobox, skip
+	$parse_func = \&parse_skip_to_end_of_div;
+      } elsif ($attrs{'class'} eq 'Column') {
+	# end of food
+	finish_food();
+	finish_day();
+	$parse_func = \&parse_open_hours_begin;
+      }
+    } elsif ($token->[1] eq 'br') {
+      if ($br_is_new_food) {
+	finish_food();
+      } else {
+	$cur_food .= "\n" if ($cur_food ne "" && substr($cur_food, -1) ne "\n");
+      }
+    }
+  } elsif ($token->[0] eq 'T') {
+    my $text = $token->[1];
+    if ($day_id < 6 && $text eq $day_names[$day_id+1]) {
+      # day changed
+      finish_food();
+      finish_day();
+    } elsif ($text eq "&nbsp;") {
+      # next food
+      finish_food();
+    } else {
+      $text =~ tr/\r\n\t/   /;
+      $text =~ s/ +/ /g;
+      $text =~ s/^ +//;
+      $text =~ s/^\.+//;
+      $text =~ s/ +$//;
+      $text =~ s/sisältää ([^, \)]+)/sis.$1/ig;
+      $cur_food .= $text;
+    }
+  }
+}
+
+sub parse_monday {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    if ($token->[1] eq $day_names[0]) {
+      $parse_func = \&parse_more_food;
+    }
+  }
+}
+
+sub parse_week {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    if ($token->[1] =~ /Viikko: (\d+)/) {
+      $week = $1;
+      $parse_func = \&parse_monday;
+    }
+  }
+}
+
+sub parse_juvenes {
+  my ($fname, $info_ref) = @_;
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
+
+  my $title = @{$info_ref}[0];
+  $week = "";
+  $open_hours = "";
+  $day_id = 0;
+  $cur_food = "";
+  @cur_day_foods = ();
+  @week_foods = ();
+  $br_is_new_food = $title eq $zip_salaattibaari_title;
+  $cur_title = $title;
+  
+  $parse_func = \&parse_week;
+  while (my $token = $p->get_token) {
+    &$parse_func($token);
+  }
+  push @restaurants, [ $title, $open_hours, $week, [ @week_foods ], $info_ref ];
+}
+
+sub can_merge_bio_kliininen {
+  my $day = shift;
+
+  my $bio_foods = "";
+  my $kliininen_foods = "";
+  my $food_dest;
+  foreach my $r (@restaurants) {
+    my ($title, $open_hours, $week, $week_foods_ref) = @{$r};
+    if ($title eq $bio_title) {
+      $food_dest = \$bio_foods;
+    } elsif ($title eq $kliininen_title) {
+      $food_dest = \$kliininen_foods;
+    } else {
+      next;
+    }
+    my @week_foods = @{$week_foods_ref};
+    foreach my $food (@{$week_foods[$day]}) {
+      ${$food_dest} .= "$food\n";
+    }
+  }
+  return $bio_foods eq $kliininen_foods;
+}
+
+sub try_merge_bio_kliininen {
+  my ($title_ref, $day) = @_;
+  my $title = $$title_ref;
+
+  if ($title eq $bio_title && can_merge_bio_kliininen($day)) {
+    $$title_ref .= " + Kliininen";
+  } elsif ($title eq $kliininen_title && can_merge_bio_kliininen($day)) {
+    return 1;
+  }
+  return 0;
+}
+
+sub get_juvenes_restaurants {
+  my $use_old = shift;
+  my $count = 0;
+  foreach my $i (@restaurant_info) {
+    my @info = @{$i};
+    my $temp_fname = "juvenes$count.temp.html";
+    my $url = $info[1];
+    if (!-f $temp_fname || !$use_old) {
+      system("wget -q --timeout=10 -O $temp_fname.tmp '$url' && mv $temp_fname.tmp $temp_fname");
+    }
+    if (-f $temp_fname) {
+      parse_juvenes($temp_fname, \@info);
+    }
+    $count++;
+  }
+  return @restaurants;
+}
+
+1;

pky.pl

@@ -0,0 +1,169 @@
+use vars qw(@day_names);
+
+my @short_day_names = ( "ma", "ti", "ke", "to", "pe", "la", "su" );
+
+#my $pky_url = "http://www.pky.fi/lounaslistat";
+my $pky_url = "http://www.pikante.fi/index.php/Pikante/lounaaksi-t%C3%A4n%C3%A4%C3%A4n.html";
+
+my @restaurant_info = (
+  [ "(TAYS) Finn-Medi", "$pky_url", "all", "middle" ],
+  [ "(TAYS) Café Olive", "$pky_url", "all", "middle" ],
+  [ "(TAYS) Ellipsi", "$pky_url", "all", "middle" ]
+);
+
+my ($parse_func, $day_id, $week);
+my (@cur_day_foods, @week_foods);
+my ($show_next_week, $content_title);
+
+sub utf8_to_8859 {
+  $_ = shift;
+
+  s/ //g;
+  s/é/é/g;
+  s/ä/ä/g;
+  s/ö/ö/g;
+  s/Ä/Ä/g;
+  s/Ö/Ö/g;
+  return $_;
+}
+
+sub pky_finish_day {
+  push @week_foods, [@cur_day_foods];
+  @cur_day_foods = ();
+  $day_id = $day_id + 1;
+}
+
+sub pky_parse_more_food {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    my $text = utf8_to_8859($token->[1]);
+    foreach my $text (split("/", $text)) {
+      push @cur_day_foods, $text if ($text ne "");
+    }
+  } elsif ($token->[0] eq 'E') {
+    if ($token->[1] eq 'tr') {
+      pky_finish_day();
+      $parse_func = \&pky_parse_day_td;
+    }
+  }
+}
+
+sub pky_parse_day_td {
+  my $token = shift;
+  
+  if ($token->[0] eq 'E') {
+    if ($token->[1] eq 'td') {
+      $parse_func = \&pky_parse_more_food;
+    } elsif ($token->[1] eq 'table') {
+      $parse_func = \&pky_parse_to_week;
+    }
+  } elsif ($token->[0] eq 'T') {
+    my $text = $token->[1];
+    my $i = 0;
+    foreach my $day (@short_day_names) {
+      if ($text =~ /$day$/i) {
+	while ($day_id < $i) {
+	  push @week_foods, [ ];
+	  $day_id++;
+	}
+	last;
+      }
+      $i++;
+    }
+  }
+}
+
+sub pky_parse_to_monday {
+  my $token = shift;
+  
+  if ($token->[0] eq 'S' && $token->[1] eq 'tr') {
+    $parse_func = \&pky_parse_day_td;
+  } elsif ($token->[0] eq 'E' && $token->[1] eq 'table') {
+    $parse_func = \&pky_parse_to_week;
+  }
+}
+
+sub want_second_week {
+  my $week = shift;
+
+  return 1 if $day_id == 0; # week didn't start from beginning
+  
+  my @l = localtime;
+  my $this_week = strftime("%V", @l);
+  return $week == $this_week || ($l[6] == 6 && ($week%52)+1 == $this_week);
+}
+
+sub pky_parse_to_eof {
+}
+
+sub pky_parse_to_week {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T' && $token->[1] =~ /Viikko (\d+)/) {
+    my $parsed_week = $1;
+    # earlier version could have shown two tables for two weeks
+    # sometimes. but the new version? dunno yet..
+    #if ($week == 0 || $show_next_week) {
+    if ($week == 0) {
+      $week = $parsed_week;
+      $day_id = 0;
+      @cur_day_foods = ();
+      @week_foods = ();
+      $parse_func = \&pky_parse_to_monday;
+    } else {
+      $parse_func = \&pky_parse_to_eof;
+    }
+  }
+}
+
+sub pky_parse_to_title {
+  my $token = shift;
+  
+  if ($token->[0] eq 'T') {
+    my $text = utf8_to_8859($token->[1]);
+    if ($text =~ /$content_title.*lounasaika/) {
+      $parse_func = \&pky_parse_to_week;
+    }
+  }
+}
+
+sub parse_pky {
+  my ($fname, $info_ref) = @_;
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
+  
+  my $title = @{$info_ref}[0];
+  $week = 0;
+  
+  $content_title = $title;
+  $content_title =~ s/^\(TAYS\) //;
+
+  $parse_func = \&pky_parse_to_title;
+  while (my $token = $p->get_token) {
+    &$parse_func($token);
+  }
+  return [ $title, "", $week, [ @week_foods ], $info_ref ];
+}
+
+sub get_pky_restaurants {
+  my $use_old;
+  ($use_old, $show_next_week) = @_;
+
+  my $temp_fname = "pky.temp.html";
+  if (!-f $temp_fname || !$use_old) {
+    system("wget -q --timeout=10 -O $temp_fname.tmp '$pky_url' && mv $temp_fname.tmp $temp_fname");
+  }
+  
+  my @restaurants = ();
+  if (-f $temp_fname) {
+    my $count = 0;
+    foreach my $i (@restaurant_info) {
+      my @info = @{$i};
+      push @restaurants, parse_pky($temp_fname, \@info);
+      $count++;
+    }
+  }
+  return @restaurants;
+}
+
+1;

sodexo.pl

@@ -0,0 +1,155 @@
+use vars qw(@day_names);
+
+my @restaurant_info = (
+  #[ "(TaY) Sodexo Linna", "http://www.sodexo.fi/fi-FI/linna/lounas/", "right" ],
+  #[ "(TTY) Sodexo Erkkeri", "http://www.sodexo.fi/fi-FI/erkkeri/lounas/", "left" ]
+  [ "(TaY) Sodexo Linna", "http://www.sodexo.fi/linna", "right" ],
+  [ "(TTY) Sodexo Erkkeri", "http://www.sodexo.fi/erkkeri", "left" ]
+);
+
+my ($cur_text, $cur_title, $parse_func, $day_id, $week);
+my (@cur_day_foods, @week_foods);
+
+sub sodexo_finish_day {
+  push @week_foods, [@cur_day_foods];
+  @cur_day_foods = ();
+  $day_id = $day_id + 1;
+}
+
+sub utf8_to_8859 {
+  $_ = shift;
+
+  s/ä/ä/g;
+  s/ö/ö/g;
+  s/Ä/Ä/g;
+  s/Ö/Ö/g;
+  return $_;
+}
+
+sub sodexo_parse_finish {
+}
+
+sub sodexo_parse_after_food {
+  my $token = shift;
+
+  if ($token->[0] eq 'E' && $token->[1] eq 'tbody') {
+    sodexo_finish_day();
+    $parse_func = \&sodexo_parse_finish;
+  } elsif ($token->[0] eq 'S' && $token->[1] eq 'td') {
+    $parse_func = \&sodexo_parse_to_food;
+  } elsif ($token->[0] eq 'S' && $token->[1] eq 'th') {
+    sodexo_finish_day();
+    $parse_func = \&sodexo_parse_to_food;
+  }
+}
+
+sub sodexo_finish_food {
+  if ($cur_text ne "") {
+    push @cur_day_foods, "$cur_title ($cur_text)";
+  } else {
+    push @cur_day_foods, "$cur_title";
+  }
+  $parse_func = \&sodexo_parse_after_food;
+}
+
+sub sodexo_parse_allergy {
+  my $token = shift;
+
+  if ($token->[0] eq 'T' && !($token->[1] =~ /\s*\/\s*/)) {
+    my $text = $token->[1];
+    $text =~ s/^\s+//;
+    $text =~ s/\s+$//;
+    $cur_text .= ", " if $cur_text ne "";
+    $cur_text .= $text;
+  } elsif ($token->[0] eq 'E' && $token->[1] eq 'td') {
+    sodexo_finish_food();
+  }
+}
+
+sub sodexo_parse_to_allergy {
+  my $token = shift;
+
+  if ($token->[0] eq 'S' && $token->[1] eq 'td') {
+    my %attrs = %{$token->[2]};
+    if ($attrs{'class'} eq 'food-properties') {
+      $parse_func = \&sodexo_parse_allergy;
+    }
+  }
+}
+
+sub sodexo_parse_food {
+  my $token = shift;
+
+  if ($token->[0] eq 'T' && $token->[1] =~ /\S/) {
+     $cur_title = utf8_to_8859($token->[1]);
+     $parse_func = \&sodexo_parse_to_allergy;
+  }
+}
+
+sub sodexo_parse_to_food {
+  my $token = shift;
+  if ($token->[0] eq 'S' && $token->[1] eq "td") {
+    my %attrs = %{$token->[2]};
+    if ($attrs{'class'} eq "food-desc") {
+      $cur_title = '';
+      $cur_text = '';
+      $parse_func = \&sodexo_parse_food;
+    }
+  }
+}
+
+sub sodexo_parse_week {
+  my $token = shift;
+  if ($token->[0] eq 'T' && $token->[1] =~ /Viikko (\d+)/) {
+    $week = $1;
+    $parse_func = \&sodexo_parse_to_food;
+  }
+}
+
+sub sodexo_parse_to_week {
+  my $token = shift;
+  if ($token->[0] eq 'S' && $token->[1] eq 'div') {
+    my %attrs = %{$token->[2]};
+    if ($attrs{'class'} eq "list-date") {
+      $parse_func = \&sodexo_parse_week;
+    }
+  }
+}
+
+sub parse_sodexo {
+  my ($fname, $info_ref) = @_;
+  my $title = @{$info_ref}[0];
+  my $url = @{$info_ref}[1];
+  my $align = @{$info_ref}[2];
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
+
+  $week = "";
+  $day_id = 0;
+  @cur_day_foods = ();
+  @week_foods = ();
+
+  $parse_func = \&sodexo_parse_to_week;
+  while (my $token = $p->get_token) {
+    &$parse_func($token);
+  }
+  return [ $title, "", $week, [ @week_foods ], [ $title, $url, "M", $align ] ];
+}
+
+sub get_sodexo_restaurants {
+  my $use_old = shift;
+  my $count = 0;
+  my @restaurants = ();
+  foreach my $i (@restaurant_info) {
+    my @info = @{$i};
+    my $temp_fname = "sodexo$count.temp.html";
+    my $url = $info[1];
+    if (!-f $temp_fname || !$use_old) {
+      system("wget -q --timeout=10 -O $temp_fname.tmp '$url' && mv $temp_fname.tmp $temp_fname");
+      return undef if (!-f $temp_fname);
+    }
+    push @restaurants, parse_sodexo($temp_fname, \@info);
+  }
+  return @restaurants;
+}
+
+1;