PNA.fi koodi

food.pl 14KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473
  1. #!/usr/bin/env perl
  2. # Ruokalistaparseri v1.5.4
  3. # Copyright (c) 2007-2010 Timo Sirainen
  4. # 2011-2013 Toni Fadjukoff
  5. # This is Public Domain
  6. use strict;
  7. use POSIX qw(strftime mktime);
  8. use HTML::TokeParser;
  9. use HTML::Entities;
  10. use vars qw(@day_names);
  11. @day_names = ( "Maanantai", "Tiistai", "Keskiviikko", "Torstai",
  12. "Perjantai", "Lauantai", "Sunnuntai" );
  13. require 'amica.pl';
  14. require 'sodexo.pl';
  15. require 'juvenes.pl';
  16. require 'pky.pl';
  17. my @allergies = ( "M", "L", "VL", "G", "K", "Ve" );
  18. my %allergy_descriptions = (
  19. "M" => "Maidoton",
  20. "L" => "Laktoositon",
  21. "VL" => "Vähälaktoosinen",
  22. "G" => "Gluteiiniton",
  23. "K" => "Kasvis",
  24. "Ve" => "Vegaani"
  25. );
  26. my $global_prefix = "";
  27. my $use_old = 0; # 1 is good for testing, 0 for production system!
  28. my @unordered;
  29. my @l = localtime;
  30. my $this_week = strftime("%V", @l);
  31. push @unordered, get_juvenes_restaurants($use_old);
  32. push @unordered, get_amica_restaurant($use_old);
  33. push @unordered, get_sodexo_restaurants($use_old);
  34. push @unordered, get_pky_restaurants($use_old, $l[6] == 0 || $l[6] == 6);
  35. my $max_week = 0;
  36. foreach my $r (@unordered) {
  37. my $week = @{$r}[2];
  38. $max_week = $week if ($week > $max_week || $week == 1);
  39. }
  40. if ($l[6] != 0 && $this_week != $max_week) {
  41. # it's not sunday, don't force next week's menu yet
  42. $max_week = $this_week;
  43. }
  44. my $stamp = time() - 3600*24*7;
  45. my $max_week_daterange = "";
  46. if ($max_week >= 1 && $max_week <= 52) {
  47. # figure out the date range
  48. for (;;) {
  49. my $stamp_week = strftime("%V", localtime($stamp));
  50. last if ($stamp_week == $max_week);
  51. $stamp += 3600*24;
  52. }
  53. my @l1 = localtime($stamp);
  54. my @l2 = localtime($stamp + 3600*24*6);
  55. if ($l1[4] == $l2[4]) {
  56. # same month
  57. $max_week_daterange = $l1[3]."-".$l2[3].".".($l1[4]+1).".";
  58. } else {
  59. # different months
  60. $max_week_daterange = $l1[3].".".($l1[4]+1)."-".$l2[3].".".($l2[4]+1).".";
  61. }
  62. $max_week_daterange = " ($max_week_daterange)"
  63. }
  64. my $file_header = '<?xml version="1.0" encoding="iso-8859-1"?>
  65. <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
  66. <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="fi" lang="fi">
  67. <head>
  68. <title>Ruokalistat</title>
  69. <link rel="stylesheet" type="text/css" href="'.$global_prefix.'/ruoka.css" />
  70. </head>
  71. <body>
  72. <div id="notice" style="border: 1px solid black; border-radius: 5px; padding: 5px;">
  73. 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>
  74. </div>
  75. <form method="get" action="/cgi-bin/food.cgi">
  76. ';
  77. my $file_footer = "<div class=\"footer\">Päivitetty ".
  78. strftime("%d.%m.%Y %H:%M:%S", localtime).
  79. " <input type=\"submit\" value=\"Päivitä nyt\" />".
  80. " / Palaute <a href=\"mailto:lamperi+pna\@gmail.com\">lamperi+pna\@gmail.com</a>".
  81. " / <a href=\"$global_prefix/code.html\">Koodit täältä</a>".
  82. " / <a href=\"$global_prefix/pna.html\">Mikä on PNA?</a>".
  83. "</div>\n</form>\n</body></html>\n";
  84. sub find_last_day_with_foods {
  85. my $restaurants_ref = shift;
  86. my $last_day = 0;
  87. foreach my $r (@${restaurants_ref}) {
  88. my ($title, $open_hours, $week, $week_foods_ref) = @{$r};
  89. my @week_foods = @{$week_foods_ref};
  90. for (my $day = 0; $day < 7; $day++) {
  91. if (defined($week_foods[$day])) {
  92. $last_day = $day if ($day > $last_day);
  93. }
  94. }
  95. }
  96. return $last_day;
  97. }
  98. sub write_days_header {
  99. my ($fout, $day, $last_day) = @_;
  100. print $fout " <span class=\"days\">";
  101. for (my $i = 0; $i <= $last_day; $i++) {
  102. if ($i == $day) {
  103. print $fout $day_names[$i]." ";
  104. } else {
  105. print $fout "<a href=\"".($i+1).".html\">".$day_names[$i]."</a> ";
  106. }
  107. }
  108. if ($day < 0) {
  109. print $fout "Taulukko";
  110. } else {
  111. print $fout "<a href=\"table.html\">Taulukko</a>";
  112. }
  113. print $fout "</span>\n";
  114. }
  115. sub write_prefix_header {
  116. my ($fout, $prefix, $day) = @_;
  117. $day = "table" if ($day == 0);
  118. print $fout "<span class=\"location\">";
  119. if ($prefix eq "") {
  120. print $fout "Kaikki ";
  121. } else {
  122. print $fout "<a href=\"$global_prefix/$day.html\">Kaikki</a> ";
  123. }
  124. if ($prefix eq "tay/") {
  125. print $fout "TaY ";
  126. } else {
  127. print $fout "<a href=\"$global_prefix/tay/$day.html\">TaY</a> ";
  128. }
  129. if ($prefix eq "tays/") {
  130. print $fout "TAYS ";
  131. } else {
  132. print $fout "<a href=\"$global_prefix/tays/$day.html\">TAYS</a> ";
  133. }
  134. if ($prefix eq "tty/") {
  135. print $fout "TTY ";
  136. } else {
  137. print $fout "<a href=\"$global_prefix/tty/$day.html\">TTY</a> ";
  138. }
  139. print $fout "</span>\n";
  140. }
  141. sub write_day {
  142. my ($day, $header, $outfname, $last_day, $restaurants_ref, $prefix) = @_;
  143. my @restaurants = @{$restaurants_ref};
  144. open(my $fout, ">$outfname") || die ("Can't create file $outfname");
  145. print $fout "$file_header<h1>$header</h1>\n";
  146. # print weekday links
  147. print $fout "<div class=\"title\">\n";
  148. write_days_header($fout, $day, $last_day);
  149. print $fout " <span class=\"allergy\">Näytä: ";
  150. foreach my $a (@allergies) {
  151. print $fout "<input type=\"checkbox\" name=\"allergy_$a\" id=\"allergy_$a\" onclick=\"highlight()\" />";
  152. print $fout "<span title=\"".$allergy_descriptions{$a}."\">$a</span>";
  153. }
  154. print $fout "</span>\n";
  155. write_prefix_header($fout, $prefix, $day+1);
  156. print $fout "</div>\n";
  157. # print foods
  158. my $foodnum = 0;
  159. my %eatable_food_numbers;
  160. my %maybe_eatable_food_numbers;
  161. my $class = "left";
  162. print $fout "<div class=\"foods\"><div class=\"$class\">\n";
  163. foreach my $r (@restaurants) {
  164. my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
  165. my ($title2, $url, $lazy_allergies, $info_class) = @{$info_ref};
  166. my @week_foods = @{$week_foods_ref};
  167. if (defined($week_foods[$day]) || $day < 5) {
  168. # Bio+Kliininen often have the same foods
  169. next if (try_merge_bio_kliininen(\$title, $day));
  170. if ($info_class ne $class) {
  171. $class = $info_class;
  172. print $fout "</div><div class=\"$class\">\n";
  173. }
  174. $url =~ s/&/&amp;/g;
  175. print $fout "<h2><a href=\"$url\">$title</a></h2>\n";
  176. if (!defined($week_foods[$day])) {
  177. print $fout "<p class=\"missing\">Ruokalistaa ei saatavilla.</p>";
  178. next;
  179. }
  180. if ($week ne "" && $week != $max_week) {
  181. if ($week > $max_week || ($week == 1 && $max_week == 52)) {
  182. # early..
  183. print $fout "<p class=\"nextweek\">Viikon $week ruokalista:</p>";
  184. } else {
  185. print $fout "<p class=\"missing\">Saatavilla vain viikon $week ruokalista.</p>";
  186. next;
  187. }
  188. }
  189. if (scalar(@{$week_foods[$day]}) == 0) {
  190. print $fout "<p class=\"missing\">Ei ruokatietoja päivälle.</p>";
  191. next;
  192. }
  193. print $fout "<ul class=\"food\">\n";
  194. foreach my $food (@{$week_foods[$day]}) {
  195. my $output = "";
  196. my %total_allergies;
  197. my %maybe_allergies;
  198. my $part_count = 0;
  199. foreach my $part (split("\n", $food)) {
  200. next if ($part =~ /^(Peruna|Riisi) /); # who cares?
  201. # fries: well, maybe we do care, but we don't care about allergy stuff
  202. # and keep it in the same line as the previous food so as not to
  203. # waste visible space
  204. my $fries = ($part =~ /^(Tikkuperunat|Ranskalaiset perunat)/);
  205. $part_count++;
  206. # add missing () around allergies
  207. $part =~ s/ (([MLGK]|VL|Ve|Veg|Hot)(,([MLGK]|VL|Ve|Veg|Hot|))+)$/ ($1)/;
  208. if ($part =~ /^(.*) \(([^\)]+)\)$/) {
  209. # fix allergy issues
  210. my ($food, $allergy) = ($1, $2);
  211. # standardization
  212. $allergy =~ s/Kasvis/K/g;
  213. $allergy =~ s/([MLGK]|VL)([MLGK]|VL)/$1,$2/g;
  214. # spaces to commas
  215. $allergy =~ s/saatavana[: ]+(.*)$/eriks: $1/;
  216. $allergy =~ s/ +/,/g;
  217. # remove double commas
  218. $allergy =~ s/,+/,/g;
  219. # eriks: standardization
  220. $allergy =~ s/,?eriks:,?/, eriks: /g;
  221. # remove extra commas/spaces from beginning/end
  222. $allergy =~ s/^[, ]+//;
  223. $allergy =~ s/[, ]+$//;
  224. $part = "$food ($allergy)";
  225. }
  226. $output .= "<br />\n" if ($output ne "" && !$fries);
  227. if ($part =~ /Saatavana myös: (.*)/) {
  228. # standardize allergy stuff
  229. my $alt = $1;
  230. $alt =~ s/^\((.*)\)$/$1/;
  231. $alt =~ s/[, ]+/,/g;
  232. $alt =~ s/^,+//;
  233. $alt =~ s/,+$//;
  234. $part =~ s/\)[- ]*Saatavana myös:.*/, eriks: $alt)/;
  235. $part =~ s/[- ]*Saatavana myös:.*/ (eriks: $alt)/;
  236. }
  237. if ($part =~ /^(.*)(\([^\)]+\))$/) {
  238. my ($text, $allergy) = ($1, $2);
  239. if ($fries) {
  240. $output .= ", $text";
  241. } else {
  242. $output .= "$text <span class=\"allergy\">$allergy</span>";
  243. }
  244. $allergy =~ s/^\((.*)\)$/$1/;
  245. $allergy =~ s/ *eriks: //;
  246. my %this_allergies;
  247. foreach my $a (split(/[, ]/, $allergy)) {
  248. foreach my $al (@allergies) {
  249. if ($a eq $al) {
  250. $this_allergies{$a} = 1;
  251. last;
  252. }
  253. }
  254. }
  255. # is M=L always correct? not at least in all restaurants..
  256. #$this_allergies{"L"} = 1 if ($this_allergies{"M"});
  257. $this_allergies{"VL"} = 1 if ($this_allergies{"L"});
  258. foreach my $a (keys %this_allergies) {
  259. $total_allergies{$a}++;
  260. $maybe_allergies{$a}++;
  261. }
  262. if ($lazy_allergies =~ /M/) {
  263. # L might mean M
  264. if ($this_allergies{"L"} && !$this_allergies{"M"}) {
  265. $maybe_allergies{"M"}++;
  266. }
  267. }
  268. } else {
  269. if ($lazy_allergies eq "all") {
  270. # no allergy info, make everything maybe
  271. foreach my $a (@allergies) {
  272. $maybe_allergies{$a}++;
  273. }
  274. }
  275. $output .= $part;
  276. }
  277. }
  278. my $allergy_output = "";
  279. foreach my $a (@allergies) {
  280. if ($total_allergies{$a} == $part_count) {
  281. if (!defined($eatable_food_numbers{$a})) {
  282. $eatable_food_numbers{$a} = "";
  283. } else {
  284. $eatable_food_numbers{$a} .= ",";
  285. }
  286. $eatable_food_numbers{$a} .= $foodnum;
  287. } elsif ($maybe_allergies{$a} == $part_count) {
  288. if (!defined($maybe_eatable_food_numbers{$a})) {
  289. $maybe_eatable_food_numbers{$a} = "";
  290. } else {
  291. $maybe_eatable_food_numbers{$a} .= ",";
  292. }
  293. $maybe_eatable_food_numbers{$a} .= $foodnum;
  294. }
  295. }
  296. print $fout " <li id=\"f$foodnum\">$output</li>\n";
  297. $foodnum++;
  298. }
  299. print $fout "</ul>\n";
  300. }
  301. }
  302. # write allergy scripts
  303. print $fout '<script type="text/javascript" src="'.$global_prefix.'/ruoka.js"></script>';
  304. print $fout '<script type="text/javascript">';
  305. print $fout "var eatable_foods = [];";
  306. print $fout "var maybe_eatable_foods = [];";
  307. foreach my $a (@allergies) {
  308. print $fout "eatable_foods[\"$a\"] = [".$eatable_food_numbers{$a}."];\n";
  309. print $fout "maybe_eatable_foods[\"$a\"] = [".$maybe_eatable_food_numbers{$a}."];\n";
  310. }
  311. my @allergy_strings = map('"'.$_.'"', @allergies);
  312. print $fout "var allergies = [".join(",", @allergy_strings)."];\n";
  313. print $fout "var food_count = $foodnum\n";
  314. print $fout "window.onload = function() { set_allergies(); show_warning(); };\n";
  315. print $fout "</script>\n";
  316. print $fout "</div></div>$file_footer";
  317. close $fout;
  318. }
  319. sub write_all_days {
  320. my ($restaurants_ref, $prefix, $title) = @_;
  321. my $last_day = find_last_day_with_foods($restaurants_ref);
  322. for (my $day = 0; $day < 7; $day++) {
  323. my $outfname = $prefix.($day+1).".html";
  324. if ($day > $last_day) {
  325. unlink($outfname);
  326. next;
  327. }
  328. my $header = $day_names[$day]." - $title vko $max_week$max_week_daterange";
  329. write_day($day, $header, $outfname, $last_day, $restaurants_ref, $prefix);
  330. }
  331. }
  332. sub write_table {
  333. my ($restaurants_ref, $prefix, $title) = @_;
  334. my @restaurants = @{$restaurants_ref};
  335. my $last_day = find_last_day_with_foods($restaurants_ref);
  336. my $outfname = $prefix."table.html";
  337. open(my $fout, ">$outfname") || die ("Can't create file $outfname");
  338. my $header = "$title vko $max_week$max_week_daterange";
  339. print $fout "$file_header<h1>$header</h1>\n";
  340. print $fout "<div class=\"title\">\n";
  341. write_days_header($fout, -1, $last_day);
  342. write_prefix_header($fout, $prefix, 0);
  343. print $fout "</div><table border=\"1\"><tr><th>Päivä</th>";
  344. foreach my $r (@restaurants) {
  345. my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
  346. my ($title2, $url) = @{$info_ref};
  347. $url =~ s/&/&nbsp;/g;
  348. print $fout "<th><a href=\"$url\">$title</a></th>";
  349. }
  350. print $fout "</tr>\n";
  351. for (my $day = 0; $day <= $last_day; $day++) {
  352. print $fout "<tr><td>".$day_names[$day]."</td>\n";
  353. foreach my $r (@restaurants) {
  354. my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
  355. my @week_foods = @{$week_foods_ref};
  356. if (defined($week_foods[$day]) && ($week eq "" || $week == $max_week)) {
  357. print $fout "<td><ul>\n";
  358. foreach my $food (@{$week_foods[$day]}) {
  359. print $fout "<li>$food</li>";
  360. }
  361. print $fout "</ul></td>\n";
  362. } else {
  363. print $fout "<td></td>\n";
  364. }
  365. }
  366. print $fout "</tr>\n";
  367. }
  368. print $fout "</table>$file_footer";
  369. close $fout;
  370. }
  371. sub get_restaurants_sorted {
  372. my @restaurants = @_;
  373. my @out;
  374. foreach my $r (@restaurants) {
  375. push @out, $r if (@{@{$r}[4]}[3] eq "left");
  376. }
  377. foreach my $r (@restaurants) {
  378. push @out, $r if (@{@{$r}[4]}[3] eq "right");
  379. }
  380. foreach my $r (@restaurants) {
  381. my @e = @{@{$r}[4]};
  382. push @out, $r if ($e[3] eq "middle" && $e[1] !~ /TAMK/);
  383. }
  384. foreach my $r (@restaurants) {
  385. my @e = @{@{$r}[4]};
  386. push @out, $r if ($e[3] eq "middle" && $e[1] =~ /TAMK/);
  387. }
  388. return @out;
  389. }
  390. sub get_restaurants_with_prefix {
  391. my $prefix = shift;
  392. my @out;
  393. foreach my $r (@_) {
  394. my $name = @{$r}[0];
  395. if ($name =~ /^\($prefix\)/) {
  396. push @out, $r;
  397. }
  398. }
  399. return get_restaurants_sorted(@out);
  400. }
  401. my $tty_title = "TTY:n ruokalistat";
  402. my @tty = get_restaurants_with_prefix("TTY", @unordered);
  403. write_all_days(\@tty, "tty/", $tty_title);
  404. write_table(\@tty, "tty/", $tty_title);
  405. my $tay_title = "Tampereen yliopiston ruokalistat";
  406. my @tay = get_restaurants_with_prefix("TaY", @unordered);
  407. write_all_days(\@tay, "tay/", $tay_title);
  408. write_table(\@tay, "tay/", $tay_title);
  409. my $tays_title = "TAYS:n ruokalistat";
  410. my @tays = get_restaurants_with_prefix("TAYS", @unordered);
  411. write_all_days(\@tays, "tays/", $tays_title);
  412. write_table(\@tays, "tays/", $tays_title);
  413. foreach my $r (@unordered) {
  414. if (@{$r}[0] =~ /^\(TaY\)/) {
  415. @{@{$r}[4]}[3] = "left";
  416. }
  417. if (@{$r}[0] =~ /^\(TTY\)/) {
  418. @{@{$r}[4]}[3] = "right";
  419. }
  420. if (@{$r}[0] =~ /^\(TAYS\)/) {
  421. @{@{$r}[4]}[3] = "middle";
  422. }
  423. }
  424. my $all_title = "Tampereen yliopistojen ruokalistat";
  425. my @all_restaurants = get_restaurants_sorted(@unordered);
  426. # move fusion kitchen last
  427. my @fusion = splice(@all_restaurants, 1, 1);
  428. splice(@all_restaurants, 4, 0, @fusion);
  429. write_all_days(\@all_restaurants, "", $all_title);
  430. write_table(\@all_restaurants, "", $all_title);