Accueil Explorateur Aide
Connexion
lamperi
/
pna
Suivre 1
Voter 0
Bifurcation 0
Code Tickets 0 Demandes d'ajout 0 Versions 0 Wiki Activité
PNA.fi koodi
21 Révisions
1 Branches
Aborescence: f7f5b31bb2
Branches Tags
${ item.name }
Créer la branche ${ searchTerm }
de 'f7f5b31bb2'
${ noResults }
pna/food.pl

food.pl 14KB
Historique Brut

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474 
  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_juvenes_restaurants($use_old);

  40. push @unordered, get_amica_restaurant($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.

  87. Jos huomaat ruokalistassa virheen, nopeiten asia korjaantuu kun lähetät minulle siitä sähköpostia: <a href="mailto:lamperi+pna@gmail.com">lamperi+pna@gmail.com</a>

  88. </div>

  89. 

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

  91. ';

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

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

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

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

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

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

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

  99. 

  100. sub find_last_day_with_foods {

  101.   my $restaurants_ref = shift;

  102. 

  103.   my $last_day = 0;

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

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

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

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

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

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

  110.       }

  111.     }

  112.   }

  113.   return $last_day;

  114. }

  115. 

  116. sub write_days_header {

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

  118.   

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

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

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

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

  123.     } else {

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

  125.     }

  126.   }

  127.   if ($day < 0) {

  128.     print $fout "Taulukko";

  129.   } else {

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

  131.   }

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

  133. }

  134. 

  135. sub write_prefix_header {

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

  137.   

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

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

  140.   if ($prefix eq "") {

  141.     print $fout "Kaikki ";

  142.   } else {

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

  144.   }

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

  146.     print $fout "TaY ";

  147.   } else {

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

  149.   }

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

  151.     print $fout "TAYS ";

  152.   } else {

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

  154.   }

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

  156.     print $fout "TTY ";

  157.   } else {

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

  159.   }

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

  161. }

  162. 

  163. sub write_day {

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

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

  166. 

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

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

  169.   # print weekday links

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

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

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

  173.   foreach my $a (@allergies) {

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

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

  176.   }

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

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

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

  180. 

  181.   # print foods

  182.   my $foodnum = 0;

  183.   my %eatable_food_numbers;

  184.   my %maybe_eatable_food_numbers;

  185.   my $class = "left";

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

  187.   foreach my $r (@restaurants) {

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

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

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

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

  192.       # Bio+Kliininen often have the same foods

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

  194. 

  195.       if ($info_class ne $class) {

  196. 	$class = $info_class;

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

  198.       }

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

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

  201.       

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

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

  204. 	next;

  205.       }

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

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

  208. 	  # early..

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

  210. 	} else {

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

  212. 	  next;

  213. 	}

  214.       }

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

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

  217. 	next;

  218.       }

  219.       

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

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

  222. 	my $output = "";

  223. 	my %total_allergies;

  224. 	my %maybe_allergies;

  225. 	my $part_count = 0;

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

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

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

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

  230. 	  # waste visible space

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

  232. 	  $part_count++;

  233. 	  

  234. 	  # add missing () around allergies

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

  236. 	  

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

  238. 	    # fix allergy issues

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

  240. 	    # standardization

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

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

  243. 	    # spaces to commas

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

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

  246. 	    # remove double commas

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

  248. 	    # eriks: standardization

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

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

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

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

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

  254. 	  }

  255. 	  

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

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

  258. 	    # standardize allergy stuff

  259. 	    my $alt = $1;

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

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

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

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

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

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

  266. 	  }

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

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

  269. 	    if ($fries) {

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

  271. 	    } else {

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

  273. 	    }

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

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

  276. 	    my %this_allergies;

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

  278. 	      foreach my $al (@allergies) {

  279. 		if ($a eq $al) {

  280. 		  $this_allergies{$a} = 1;

  281. 		  last;

  282. 		}

  283. 	      }

  284. 	    }

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

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

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

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

  289. 	      $total_allergies{$a}++;

  290. 	      $maybe_allergies{$a}++;

  291. 	    }

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

  293. 	      # L might mean M

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

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

  296. 	      }

  297. 	    }

  298. 	  } else {

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

  300. 	      # no allergy info, make everything maybe

  301. 	      foreach my $a (@allergies) {

  302. 		$maybe_allergies{$a}++;

  303. 	      }

  304. 	    }

  305. 	    $output .= $part;

  306. 	  }

  307. 	}

  308. 	my $allergy_output = "";

  309. 	foreach my $a (@allergies) {

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

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

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

  313. 	    } else {

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

  315. 	    }

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

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

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

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

  320. 	    } else {

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

  322. 	    }

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

  324. 	  }

  325. 	}

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

  327. 	$foodnum++;

  328.       }

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

  330.     }

  331.   }

  332.   # write allergy scripts

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

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

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

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

  337.   foreach my $a (@allergies) {

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

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

  340.   }

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

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

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

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

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

  346. 

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

  348.   close $fout;

  349. }

  350. 

  351. sub write_all_days {

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

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

  354.   

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

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

  357.     if ($day > $last_day) {

  358.       unlink($outfname);

  359.       next;

  360.     }

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

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

  363.   }

  364. }

  365. 

  366. sub write_table {

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

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

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

  370. 

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

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

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

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

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

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

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

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

  379.   foreach my $r (@restaurants) {

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

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

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

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

  384.   }

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

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

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

  388.     foreach my $r (@restaurants) {

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

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

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

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

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

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

  395. 	}

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

  397.       } else {

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

  399.       }

  400.     }

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

  402.   }

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

  404.   close $fout;

  405. }

  406. 

  407. sub get_restaurants_sorted {

  408.   my @restaurants = @_;

  409.   my @out;

  410.   foreach my $r (@restaurants) {

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

  412.   }

  413.   foreach my $r (@restaurants) {

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

  415.   }

  416.   foreach my $r (@restaurants) {

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

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

  419.   }

  420.   foreach my $r (@restaurants) {

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

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

  423.   }

  424.   return @out;

  425. }

  426. 

  427. sub get_restaurants_with_prefix {

  428.   my $prefix = shift;

  429.   my @out;

  430.   foreach my $r (@_) {

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

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

  433.       push @out, $r;

  434.     }

  435.   }

  436.   return get_restaurants_sorted(@out);

  437. }

  438. 

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

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

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

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

  443. 

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

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

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

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

  448. 

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

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

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

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

  453. 

  454. foreach my $r (@unordered) {

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

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

  457.   }

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

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

  460.   }

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

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

  463.   }

  464. }

  465. 

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

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

  468. # move fusion kitchen last

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

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

  471. 

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

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