Home Explore Help
Sign In
lamperi
/
pna
Watch 1
Star 0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
PNA.fi koodi
36 Commits
1 Branches
Tree: b78b9849b0
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from 'b78b9849b0'
${ noResults }
pna/food.pl

food.pl 14KB
History Raw

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473 
  1. #!/usr/bin/env perl

  2. 

  3. # Ruokalistaparseri v1.5.4

  4. # Copyright (c) 2007-2010 Timo Sirainen

  5. #               2011-2013 Toni Fadjukoff

  6. # This is Public Domain

  7. 

  8. use strict;

  9. use POSIX qw(strftime mktime);

  10. use HTML::TokeParser;

  11. use HTML::Entities;

  12. 

  13. use vars qw(@day_names);

  14. @day_names = ( "Maanantai", "Tiistai", "Keskiviikko", "Torstai", 

  15. 	       "Perjantai", "Lauantai", "Sunnuntai" );

  16. 

  17. require 'amica.pl';

  18. require 'sodexo.pl';

  19. require 'juvenes.pl';

  20. require 'pky.pl';

  21. 

  22. my @allergies = ( "M", "L", "VL", "G", "K", "Ve" );

  23. my %allergy_descriptions = (

  24.   "M" => "Maidoton",

  25.   "L" => "Laktoositon",

  26.   "VL" => "Vähälaktoosinen",

  27.   "G" => "Gluteiiniton",

  28.   "K" => "Kasvis",

  29.   "Ve" => "Vegaani"

  30. );

  31. 

  32. my $global_prefix = "";

  33. my $use_old = 0; # 1 is good for testing, 0 for production system!

  34. my @unordered;

  35. 

  36. my @l = localtime;

  37. my $this_week = strftime("%V", @l);

  38. 

  39. push @unordered, get_amica_restaurant($use_old);

  40. push @unordered, get_juvenes_restaurants($use_old);

  41. push @unordered, get_sodexo_restaurants($use_old);

  42. push @unordered, get_pky_restaurants($use_old, $l[6] == 0 || $l[6] == 6);

  43. 

  44. my $max_week = 0;

  45. foreach my $r (@unordered) {

  46.   my $week = @{$r}[2];

  47.   $max_week = $week if ($week > $max_week || $week == 1);

  48. }

  49. 

  50. if ($l[6] != 0 && $this_week != $max_week) {

  51.   # it's not sunday, don't force next week's menu yet

  52.   $max_week = $this_week;

  53. }

  54. 

  55. my $stamp = time() - 3600*24*7;

  56. my $max_week_daterange = "";

  57. if ($max_week >= 1 && $max_week <= 52) {

  58.   # figure out the date range

  59.   for (;;) {

  60.     my $stamp_week = strftime("%V", localtime($stamp));

  61.     last if ($stamp_week == $max_week);

  62.     $stamp += 3600*24;

  63.   }

  64.   my @l1 = localtime($stamp);

  65.   my @l2 = localtime($stamp + 3600*24*6);

  66.   if ($l1[4] == $l2[4]) {

  67.     # same month

  68.     $max_week_daterange = $l1[3]."-".$l2[3].".".($l1[4]+1).".";

  69.   } else {

  70.     # different months

  71.     $max_week_daterange = $l1[3].".".($l1[4]+1)."-".$l2[3].".".($l2[4]+1).".";

  72.   }

  73.   $max_week_daterange = " ($max_week_daterange)"

  74. }

  75. 

  76. my $file_header = '<?xml version="1.0" encoding="iso-8859-1"?>

  77. <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

  78. <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="fi" lang="fi">

  79. <head>

  80.   <title>Ruokalistat</title>

  81.   <link rel="stylesheet" type="text/css" href="'.$global_prefix.'/ruoka.css" />

  82. </head>

  83. <body>

  84. 

  85. <div id="notice" style="border: 1px solid black; border-radius: 5px; padding: 5px;">

  86. 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: <a href="mailto:lamperi+pna@gmail.com">lamperi+pna@gmail.com</a>

  87. </div>

  88. 

  89. <form method="get" action="/cgi-bin/food.cgi">

  90. ';

  91. my $file_footer = "<div class=\"footer\">Päivitetty ".

  92.     strftime("%d.%m.%Y %H:%M:%S", localtime).

  93.     " <input type=\"submit\" value=\"Päivitä nyt\" />".

  94.     " / Palaute <a href=\"mailto:lamperi+pna\@gmail.com\">lamperi+pna\@gmail.com</a>".

  95.     " / <a href=\"$global_prefix/code.html\">Koodit täältä</a>".

  96.     " / <a href=\"$global_prefix/pna.html\">Mikä on PNA?</a>".

  97.     "</div>\n</form>\n</body></html>\n";

  98. 

  99. sub find_last_day_with_foods {

  100.   my $restaurants_ref = shift;

  101. 

  102.   my $last_day = 0;

  103.   foreach my $r (@${restaurants_ref}) {

  104.     my ($title, $open_hours, $week, $week_foods_ref) = @{$r};

  105.     my @week_foods = @{$week_foods_ref};

  106.     for (my $day = 0; $day < 7; $day++) {

  107.       if (defined($week_foods[$day])) {

  108. 	$last_day = $day if ($day > $last_day);

  109.       }

  110.     }

  111.   }

  112.   return $last_day;

  113. }

  114. 

  115. sub write_days_header {

  116.   my ($fout, $day, $last_day) = @_;

  117.   

  118.   print $fout "  <span class=\"days\">";

  119.   for (my $i = 0; $i <= $last_day; $i++) {

  120.     if ($i == $day) {

  121.       print $fout $day_names[$i]." ";

  122.     } else {

  123.       print $fout "<a href=\"".($i+1).".html\">".$day_names[$i]."</a> ";

  124.     }

  125.   }

  126.   if ($day < 0) {

  127.     print $fout "Taulukko";

  128.   } else {

  129.     print $fout "<a href=\"table.html\">Taulukko</a>";

  130.   }

  131.   print $fout "</span>\n";

  132. }

  133. 

  134. sub write_prefix_header {

  135.   my ($fout, $prefix, $day) = @_;

  136.   

  137.   $day = "table" if ($day == 0);

  138.   print $fout "<span class=\"location\">";

  139.   if ($prefix eq "") {

  140.     print $fout "Kaikki ";

  141.   } else {

  142.     print $fout "<a href=\"$global_prefix/$day.html\">Kaikki</a> ";

  143.   }

  144.   if ($prefix eq "tay/") {

  145.     print $fout "TaY ";

  146.   } else {

  147.     print $fout "<a href=\"$global_prefix/tay/$day.html\">TaY</a> ";

  148.   }

  149.   if ($prefix eq "tays/") {

  150.     print $fout "TAYS ";

  151.   } else {

  152.     print $fout "<a href=\"$global_prefix/tays/$day.html\">TAYS</a> ";

  153.   }

  154.   if ($prefix eq "tty/") {

  155.     print $fout "TTY ";

  156.   } else {

  157.     print $fout "<a href=\"$global_prefix/tty/$day.html\">TTY</a> ";

  158.   }

  159.   print $fout "</span>\n";

  160. }

  161. 

  162. sub write_day {

  163.   my ($day, $header, $outfname, $last_day, $restaurants_ref, $prefix) = @_;

  164.   my @restaurants = @{$restaurants_ref};

  165. 

  166.   open(my $fout, ">$outfname") || die ("Can't create file $outfname");

  167.   print $fout "$file_header<h1>$header</h1>\n";

  168.   # print weekday links

  169.   print $fout "<div class=\"title\">\n";

  170.   write_days_header($fout, $day, $last_day);

  171.   print $fout "  <span class=\"allergy\">Näytä: ";

  172.   foreach my $a (@allergies) {

  173.     print $fout "<input type=\"checkbox\" name=\"allergy_$a\" id=\"allergy_$a\" onclick=\"highlight()\" />";

  174.     print $fout "<span title=\"".$allergy_descriptions{$a}."\">$a</span>";

  175.   }

  176.   print $fout "</span>\n";

  177.   write_prefix_header($fout, $prefix, $day+1);

  178.   print $fout "</div>\n";

  179. 

  180.   # print foods

  181.   my $foodnum = 0;

  182.   my %eatable_food_numbers;

  183.   my %maybe_eatable_food_numbers;

  184.   my $class = "left";

  185.   print $fout "<div class=\"foods\"><div class=\"$class\">\n";

  186.   foreach my $r (@restaurants) {

  187.     my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};

  188.     my ($title2, $url, $lazy_allergies, $info_class) = @{$info_ref};

  189.     my @week_foods = @{$week_foods_ref};

  190.     if (defined($week_foods[$day]) || $day < 5) {

  191.       # Bio+Kliininen often have the same foods

  192.       next if (try_merge_bio_kliininen(\$title, $day));

  193. 

  194.       if ($info_class ne $class) {

  195. 	$class = $info_class;

  196. 	print $fout "</div><div class=\"$class\">\n";

  197.       }

  198.       $url =~ s/&/&amp;/g;

  199.       print $fout "<h2><a href=\"$url\">$title</a></h2>\n";

  200.       

  201.       if (!defined($week_foods[$day])) {

  202. 	print $fout "<p class=\"missing\">Ruokalistaa ei saatavilla.</p>";

  203. 	next;

  204.       }

  205.       if ($week ne "" && $week != $max_week) {

  206. 	if ($week > $max_week || ($week == 1 && $max_week == 52)) {

  207. 	  # early..

  208. 	  print $fout "<p class=\"nextweek\">Viikon $week ruokalista:</p>";

  209. 	} else {

  210. 	  print $fout "<p class=\"missing\">Saatavilla vain viikon $week ruokalista.</p>";

  211. 	  next;

  212. 	}

  213.       }

  214.       if (scalar(@{$week_foods[$day]}) == 0) {

  215. 	print $fout "<p class=\"missing\">Ei ruokatietoja päivälle.</p>";

  216. 	next;

  217.       }

  218.       

  219.       print $fout "<ul class=\"food\">\n";

  220.       foreach my $food (@{$week_foods[$day]}) {

  221. 	my $output = "";

  222. 	my %total_allergies;

  223. 	my %maybe_allergies;

  224. 	my $part_count = 0;

  225. 	foreach my $part (split("\n", $food)) {

  226. 	  next if ($part =~ /^(Peruna|Riisi) /); # who cares?

  227. 	  # fries: well, maybe we do care, but we don't care about allergy stuff

  228. 	  # and keep it in the same line as the previous food so as not to

  229. 	  # waste visible space

  230. 	  my $fries = ($part =~ /^(Tikkuperunat|Ranskalaiset perunat)/);

  231. 	  $part_count++;

  232. 	  

  233. 	  # add missing () around allergies

  234. 	  $part =~ s/ (([MLGK]|VL|Ve|Veg|Hot)(,([MLGK]|VL|Ve|Veg|Hot|))+)$/ ($1)/;

  235. 	  

  236. 	  if ($part =~ /^(.*) \(([^\)]+)\)$/) {

  237. 	    # fix allergy issues

  238. 	    my ($food, $allergy) = ($1, $2);

  239. 	    # standardization

  240. 	    $allergy =~ s/Kasvis/K/g;

  241. 	    $allergy =~ s/([MLGK]|VL)([MLGK]|VL)/$1,$2/g;

  242. 	    # spaces to commas

  243. 	    $allergy =~ s/saatavana[: ]+(.*)$/eriks: $1/;

  244. 	    $allergy =~ s/ +/,/g;

  245. 	    # remove double commas

  246. 	    $allergy =~ s/,+/,/g;

  247. 	    # eriks: standardization

  248. 	    $allergy =~ s/,?eriks:,?/, eriks: /g;

  249. 	    # remove extra commas/spaces from beginning/end

  250. 	    $allergy =~ s/^[, ]+//;

  251. 	    $allergy =~ s/[, ]+$//;

  252. 	    $part = "$food ($allergy)";

  253. 	  }

  254. 	  

  255. 	  $output .= "<br />\n" if ($output ne "" && !$fries);

  256. 	  if ($part =~ /Saatavana myös: (.*)/) {

  257. 	    # standardize allergy stuff

  258. 	    my $alt = $1;

  259. 	    $alt =~ s/^\((.*)\)$/$1/;

  260. 	    $alt =~ s/[, ]+/,/g;

  261. 	    $alt =~ s/^,+//;

  262. 	    $alt =~ s/,+$//;

  263. 	    $part =~ s/\)[- ]*Saatavana myös:.*/, eriks: $alt)/;

  264. 	    $part =~ s/[- ]*Saatavana myös:.*/ (eriks: $alt)/;

  265. 	  }

  266. 	  if ($part =~ /^(.*)(\([^\)]+\))$/) {

  267. 	    my ($text, $allergy) = ($1, $2);

  268. 	    if ($fries) {

  269. 	      $output .= ", $text";

  270. 	    } else {

  271. 	      $output .= "$text <span class=\"allergy\">$allergy</span>";

  272. 	    }

  273. 	    $allergy =~ s/^\((.*)\)$/$1/;

  274. 	    $allergy =~ s/ *eriks: //;

  275. 	    my %this_allergies;

  276. 	    foreach my $a (split(/[, ]/, $allergy)) {

  277. 	      foreach my $al (@allergies) {

  278. 		if ($a eq $al) {

  279. 		  $this_allergies{$a} = 1;

  280. 		  last;

  281. 		}

  282. 	      }

  283. 	    }

  284. 	    # is M=L always correct? not at least in all restaurants..

  285. 	    #$this_allergies{"L"} = 1 if ($this_allergies{"M"});

  286. 	    $this_allergies{"VL"} = 1 if ($this_allergies{"L"});

  287. 	    foreach my $a (keys %this_allergies) {

  288. 	      $total_allergies{$a}++;

  289. 	      $maybe_allergies{$a}++;

  290. 	    }

  291. 	    if ($lazy_allergies =~ /M/) {

  292. 	      # L might mean M

  293. 	      if ($this_allergies{"L"} && !$this_allergies{"M"}) {

  294. 		$maybe_allergies{"M"}++;

  295. 	      }

  296. 	    }

  297. 	  } else {

  298. 	    if ($lazy_allergies eq "all") {

  299. 	      # no allergy info, make everything maybe

  300. 	      foreach my $a (@allergies) {

  301. 		$maybe_allergies{$a}++;

  302. 	      }

  303. 	    }

  304. 	    $output .= $part;

  305. 	  }

  306. 	}

  307. 	my $allergy_output = "";

  308. 	foreach my $a (@allergies) {

  309. 	  if ($total_allergies{$a} == $part_count) {

  310. 	    if (!defined($eatable_food_numbers{$a})) {

  311. 	      $eatable_food_numbers{$a} = "";

  312. 	    } else {

  313. 	      $eatable_food_numbers{$a} .= ",";

  314. 	    }

  315. 	    $eatable_food_numbers{$a} .= $foodnum;

  316. 	  } elsif ($maybe_allergies{$a} == $part_count) {

  317. 	    if (!defined($maybe_eatable_food_numbers{$a})) {

  318. 	      $maybe_eatable_food_numbers{$a} = "";

  319. 	    } else {

  320. 	      $maybe_eatable_food_numbers{$a} .= ",";

  321. 	    }

  322. 	    $maybe_eatable_food_numbers{$a} .= $foodnum;

  323. 	  }

  324. 	}

  325. 	print $fout "  <li id=\"f$foodnum\">$output</li>\n";

  326. 	$foodnum++;

  327.       }

  328.       print $fout "</ul>\n";

  329.     }

  330.   }

  331.   # write allergy scripts

  332.   print $fout '<script type="text/javascript" src="'.$global_prefix.'/ruoka.js"></script>';

  333.   print $fout '<script type="text/javascript">';

  334.   print $fout "var eatable_foods = [];";

  335.   print $fout "var maybe_eatable_foods = [];";

  336.   foreach my $a (@allergies) {

  337.     print $fout "eatable_foods[\"$a\"] = [".$eatable_food_numbers{$a}."];\n";

  338.     print $fout "maybe_eatable_foods[\"$a\"] = [".$maybe_eatable_food_numbers{$a}."];\n";

  339.   }

  340.   my @allergy_strings = map('"'.$_.'"', @allergies);

  341.   print $fout "var allergies = [".join(",", @allergy_strings)."];\n";

  342.   print $fout "var food_count = $foodnum\n";

  343.   print $fout "window.onload = function() { set_allergies(); show_warning(); };\n";

  344.   print $fout "</script>\n";

  345. 

  346.   print $fout "</div></div>$file_footer";

  347.   close $fout;

  348. }

  349. 

  350. sub write_all_days {

  351.   my ($restaurants_ref, $prefix, $title) = @_;

  352.   my $last_day = find_last_day_with_foods($restaurants_ref);

  353.   

  354.   for (my $day = 0; $day < 7; $day++) {

  355.     my $outfname = $prefix.($day+1).".html";

  356.     if ($day > $last_day) {

  357.       unlink($outfname);

  358.       next;

  359.     }

  360.     my $header = $day_names[$day]." - $title vko $max_week$max_week_daterange";

  361.     write_day($day, $header, $outfname, $last_day, $restaurants_ref, $prefix);

  362.   }

  363. }

  364. 

  365. sub write_table {

  366.   my ($restaurants_ref, $prefix, $title) = @_;

  367.   my @restaurants = @{$restaurants_ref};

  368.   my $last_day = find_last_day_with_foods($restaurants_ref);

  369. 

  370.   my $outfname = $prefix."table.html";

  371.   open(my $fout, ">$outfname") || die ("Can't create file $outfname");

  372.   my $header = "$title vko $max_week$max_week_daterange";

  373.   print $fout "$file_header<h1>$header</h1>\n";

  374.   print $fout "<div class=\"title\">\n";

  375.   write_days_header($fout, -1, $last_day);

  376.   write_prefix_header($fout, $prefix, 0);

  377.   print $fout "</div><table border=\"1\"><tr><th>Päivä</th>";

  378.   foreach my $r (@restaurants) {

  379.     my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};

  380.     my ($title2, $url) = @{$info_ref};

  381.     $url =~ s/&/&nbsp;/g;

  382.     print $fout "<th><a href=\"$url\">$title</a></th>";

  383.   }

  384.   print $fout "</tr>\n";

  385.   for (my $day = 0; $day <= $last_day; $day++) {

  386.     print $fout "<tr><td>".$day_names[$day]."</td>\n";

  387.     foreach my $r (@restaurants) {

  388.       my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};

  389.       my @week_foods = @{$week_foods_ref};

  390.       if (defined($week_foods[$day]) && ($week eq "" || $week == $max_week)) {

  391. 	print $fout "<td><ul>\n";

  392. 	foreach my $food (@{$week_foods[$day]}) {

  393. 	  print $fout "<li>$food</li>";

  394. 	}

  395. 	print $fout "</ul></td>\n";

  396.       } else {

  397. 	print $fout "<td></td>\n";

  398.       }

  399.     }

  400.     print $fout "</tr>\n";

  401.   }

  402.   print $fout "</table>$file_footer";

  403.   close $fout;

  404. }

  405. 

  406. sub get_restaurants_sorted {

  407.   my @restaurants = @_;

  408.   my @out;

  409.   foreach my $r (@restaurants) {

  410.     push @out, $r if (@{@{$r}[4]}[3] eq "left");

  411.   }

  412.   foreach my $r (@restaurants) {

  413.     push @out, $r if (@{@{$r}[4]}[3] eq "right");

  414.   }

  415.   foreach my $r (@restaurants) {

  416.     my @e = @{@{$r}[4]};

  417.     push @out, $r if ($e[3] eq "middle" && $e[1] !~ /TAMK/);

  418.   }

  419.   foreach my $r (@restaurants) {

  420.     my @e = @{@{$r}[4]};

  421.     push @out, $r if ($e[3] eq "middle" && $e[1] =~ /TAMK/);

  422.   }

  423.   return @out;

  424. }

  425. 

  426. sub get_restaurants_with_prefix {

  427.   my $prefix = shift;

  428.   my @out;

  429.   foreach my $r (@_) {

  430.     my $name = @{$r}[0];

  431.     if ($name =~ /^\($prefix\)/) {

  432.       push @out, $r;

  433.     }

  434.   }

  435.   return get_restaurants_sorted(@out);

  436. }

  437. 

  438. my $tty_title = "TTY:n ruokalistat";

  439. my @tty = get_restaurants_with_prefix("TTY", @unordered);

  440. write_all_days(\@tty, "tty/", $tty_title);

  441. write_table(\@tty, "tty/", $tty_title);

  442. 

  443. my $tay_title = "Tampereen yliopiston ruokalistat";

  444. my @tay = get_restaurants_with_prefix("TaY", @unordered);

  445. write_all_days(\@tay, "tay/", $tay_title);

  446. write_table(\@tay, "tay/", $tay_title);

  447. 

  448. my $tays_title = "TAYS:n ruokalistat";

  449. my @tays = get_restaurants_with_prefix("TAYS", @unordered);

  450. write_all_days(\@tays, "tays/", $tays_title);

  451. write_table(\@tays, "tays/", $tays_title);

  452. 

  453. foreach my $r (@unordered) {

  454.   if (@{$r}[0] =~ /^\(TaY\)/) {

  455.     @{@{$r}[4]}[3] = "left";

  456.   }

  457.   if (@{$r}[0] =~ /^\(TTY\)/) {

  458.     @{@{$r}[4]}[3] = "right";

  459.   }

  460.   if (@{$r}[0] =~ /^\(TAYS\)/) {

  461.     @{@{$r}[4]}[3] = "middle";

  462.   }

  463. }

  464. 

  465. my $all_title = "Tampereen yliopistojen ruokalistat";

  466. my @all_restaurants = get_restaurants_sorted(@unordered);

  467. # move fusion kitchen last

  468. my @fusion = splice(@all_restaurants, 1, 1);

  469. splice(@all_restaurants, 4, 0, @fusion);

  470. 

  471. write_all_days(\@all_restaurants, "", $all_title);

  472. write_table(\@all_restaurants, "", $all_title);