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
1 Commits
1 Branches
Tree: 3551713f03
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from '3551713f03'
${ noResults }
pna/food.pl

food.pl 14KB
History Raw

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

  2. 

  3. # Ruokalistaparseri v1.5.1

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

  5. # This is Public Domain

  6. 

  7. use strict;

  8. use POSIX qw(strftime mktime);

  9. use HTML::TokeParser;

  10. use HTML::Entities;

  11. 

  12. use vars qw(@day_names);

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

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

  15. 

  16. require 'amica.pl';

  17. require 'sodexo.pl';

  18. require 'juvenes.pl';

  19. require 'pky.pl';

  20. 

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

  22. my %allergy_descriptions = (

  23.   "M" => "Maidoton",

  24.   "L" => "Laktoositon",

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

  26.   "G" => "Gluteiiniton",

  27.   "K" => "Kasvis",

  28.   "Ve" => "Vegaani"

  29. );

  30. 

  31. my $global_prefix = "";

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

  33. my @unordered;

  34. 

  35. my @l = localtime;

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

  37. 

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

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

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

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

  42. 

  43. my $max_week = 0;

  44. foreach my $r (@unordered) {

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

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

  47. }

  48. 

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

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

  51.   $max_week = $this_week;

  52. }

  53. 

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

  55. my $max_week_daterange = "";

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

  57.   # figure out the date range

  58.   for (;;) {

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

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

  61.     $stamp += 3600*24;

  62.   }

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

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

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

  66.     # same month

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

  68.   } else {

  69.     # different months

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

  71.   }

  72.   $max_week_daterange = " ($max_week_daterange)"

  73. }

  74. 

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

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

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

  78. <head>

  79.   <title>Ruokalistat</title>

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

  81. </head>

  82. <body onload="set_allergies()">

  83. 

  84. 

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

  86. ';

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

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

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

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

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

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

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

  94. 

  95. sub find_last_day_with_foods {

  96.   my $restaurants_ref = shift;

  97. 

  98.   my $last_day = 0;

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

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

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

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

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

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

  105.       }

  106.     }

  107.   }

  108.   return $last_day;

  109. }

  110. 

  111. sub write_days_header {

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

  113.   

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

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

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

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

  118.     } else {

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

  120.     }

  121.   }

  122.   if ($day < 0) {

  123.     print $fout "Taulukko";

  124.   } else {

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

  126.   }

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

  128. }

  129. 

  130. sub write_prefix_header {

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

  132.   

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

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

  135.   if ($prefix eq "") {

  136.     print $fout "Kaikki ";

  137.   } else {

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

  139.   }

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

  141.     print $fout "TaY ";

  142.   } else {

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

  144.   }

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

  146.     print $fout "TAYS ";

  147.   } else {

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

  149.   }

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

  151.     print $fout "TTY ";

  152.   } else {

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

  154.   }

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

  156. }

  157. 

  158. sub write_day {

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

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

  161. 

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

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

  164.   # print weekday links

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

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

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

  168.   foreach my $a (@allergies) {

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

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

  171.   }

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

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

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

  175. 

  176.   # print foods

  177.   my $foodnum = 0;

  178.   my %eatable_food_numbers;

  179.   my %maybe_eatable_food_numbers;

  180.   my $class = "left";

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

  182.   foreach my $r (@restaurants) {

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

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

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

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

  187.       # Bio+Kliininen often have the same foods

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

  189. 

  190.       if ($info_class ne $class) {

  191. 	$class = $info_class;

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

  193.       }

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

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

  196.       

  197.       if ($title =~ /Sodexo/ || !defined($week_foods[$day])) {

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

  199. 	next;

  200.       }

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

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

  203. 	  # early..

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

  205. 	} else {

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

  207. 	  next;

  208. 	}

  209.       }

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

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

  212. 	next;

  213.       }

  214.       

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

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

  217. 	my $output = "";

  218. 	my %total_allergies;

  219. 	my %maybe_allergies;

  220. 	my $part_count = 0;

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

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

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

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

  225. 	  # waste visible space

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

  227. 	  $part_count++;

  228. 	  

  229. 	  # add missing () around allergies

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

  231. 	  

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

  233. 	    # fix allergy issues

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

  235. 	    # standardization

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

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

  238. 	    # spaces to commas

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

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

  241. 	    # remove double commas

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

  243. 	    # eriks: standardization

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

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

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

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

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

  249. 	  }

  250. 	  

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

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

  253. 	    # standardize allergy stuff

  254. 	    my $alt = $1;

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

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

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

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

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

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

  261. 	  }

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

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

  264. 	    if ($fries) {

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

  266. 	    } else {

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

  268. 	    }

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

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

  271. 	    my %this_allergies;

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

  273. 	      foreach my $al (@allergies) {

  274. 		if ($a eq $al) {

  275. 		  $this_allergies{$a} = 1;

  276. 		  last;

  277. 		}

  278. 	      }

  279. 	    }

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

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

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

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

  284. 	      $total_allergies{$a}++;

  285. 	      $maybe_allergies{$a}++;

  286. 	    }

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

  288. 	      # L might mean M

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

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

  291. 	      }

  292. 	    }

  293. 	  } else {

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

  295. 	      # no allergy info, make everything maybe

  296. 	      foreach my $a (@allergies) {

  297. 		$maybe_allergies{$a}++;

  298. 	      }

  299. 	    }

  300. 	    $output .= $part;

  301. 	  }

  302. 	}

  303. 	my $allergy_output = "";

  304. 	foreach my $a (@allergies) {

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

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

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

  308. 	    } else {

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

  310. 	    }

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

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

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

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

  315. 	    } else {

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

  317. 	    }

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

  319. 	  }

  320. 	}

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

  322. 	$foodnum++;

  323.       }

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

  325.     }

  326.   }

  327.   # write allergy scripts

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

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

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

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

  332.   foreach my $a (@allergies) {

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

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

  335.   }

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

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

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

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

  340. 

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

  342.   close $fout;

  343. }

  344. 

  345. sub write_all_days {

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

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

  348.   

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

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

  351.     if ($day > $last_day) {

  352.       unlink($outfname);

  353.       next;

  354.     }

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

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

  357.   }

  358. }

  359. 

  360. sub write_table {

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

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

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

  364. 

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

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

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

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

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

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

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

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

  373.   foreach my $r (@restaurants) {

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

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

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

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

  378.   }

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

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

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

  382.     foreach my $r (@restaurants) {

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

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

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

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

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

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

  389. 	}

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

  391.       } else {

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

  393.       }

  394.     }

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

  396.   }

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

  398.   close $fout;

  399. }

  400. 

  401. sub get_restaurants_sorted {

  402.   my @restaurants = @_;

  403.   my @out;

  404.   foreach my $r (@restaurants) {

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

  406.   }

  407.   foreach my $r (@restaurants) {

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

  409.   }

  410.   foreach my $r (@restaurants) {

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

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

  413.   }

  414.   foreach my $r (@restaurants) {

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

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

  417.   }

  418.   return @out;

  419. }

  420. 

  421. sub get_restaurants_with_prefix {

  422.   my $prefix = shift;

  423.   my @out;

  424.   foreach my $r (@_) {

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

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

  427.       push @out, $r;

  428.     }

  429.   }

  430.   return get_restaurants_sorted(@out);

  431. }

  432. 

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

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

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

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

  437. 

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

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

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

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

  442. 

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

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

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

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

  447. 

  448. foreach my $r (@unordered) {

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

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

  451.   }

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

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

  454.   }

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

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

  457.   }

  458. }

  459. 

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

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

  462. # move fusion kitchen last

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

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

  465. 

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

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