|
|
@@ -1,470 +0,0 @@
|
|
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
|
|
-
|
|
192
|
|
- if ($info_class ne $class) {
|
|
193
|
|
- $class = $info_class;
|
|
194
|
|
- print $fout "</div><div class=\"$class\">\n";
|
|
195
|
|
- }
|
|
196
|
|
- $url =~ s/&/&/g;
|
|
197
|
|
- print $fout "<h2><a href=\"$url\">$title</a></h2>\n";
|
|
198
|
|
-
|
|
199
|
|
- if (!defined($week_foods[$day])) {
|
|
200
|
|
- print $fout "<p class=\"missing\">Ruokalistaa ei saatavilla.</p>";
|
|
201
|
|
- next;
|
|
202
|
|
- }
|
|
203
|
|
- if ($week ne "" && $week != $max_week) {
|
|
204
|
|
- if ($week > $max_week || ($week == 1 && $max_week == 52)) {
|
|
205
|
|
- # early..
|
|
206
|
|
- print $fout "<p class=\"nextweek\">Viikon $week ruokalista:</p>";
|
|
207
|
|
- } else {
|
|
208
|
|
- print $fout "<p class=\"missing\">Saatavilla vain viikon $week ruokalista.</p>";
|
|
209
|
|
- next;
|
|
210
|
|
- }
|
|
211
|
|
- }
|
|
212
|
|
- if (scalar(@{$week_foods[$day]}) == 0) {
|
|
213
|
|
- print $fout "<p class=\"missing\">Ei ruokatietoja päivälle.</p>";
|
|
214
|
|
- next;
|
|
215
|
|
- }
|
|
216
|
|
-
|
|
217
|
|
- print $fout "<ul class=\"food\">\n";
|
|
218
|
|
- foreach my $food (@{$week_foods[$day]}) {
|
|
219
|
|
- my $output = "";
|
|
220
|
|
- my %total_allergies;
|
|
221
|
|
- my %maybe_allergies;
|
|
222
|
|
- my $part_count = 0;
|
|
223
|
|
- foreach my $part (split("\n", $food)) {
|
|
224
|
|
- next if ($part =~ /^(Peruna|Riisi) /); # who cares?
|
|
225
|
|
- # fries: well, maybe we do care, but we don't care about allergy stuff
|
|
226
|
|
- # and keep it in the same line as the previous food so as not to
|
|
227
|
|
- # waste visible space
|
|
228
|
|
- my $fries = ($part =~ /^(Tikkuperunat|Ranskalaiset perunat)/);
|
|
229
|
|
- $part_count++;
|
|
230
|
|
-
|
|
231
|
|
- # add missing () around allergies
|
|
232
|
|
- $part =~ s/ (([MLGK]|VL|Ve|Veg|Hot)(,([MLGK]|VL|Ve|Veg|Hot|))+)$/ ($1)/;
|
|
233
|
|
-
|
|
234
|
|
- if ($part =~ /^(.*) \(([^\)]+)\)$/) {
|
|
235
|
|
- # fix allergy issues
|
|
236
|
|
- my ($food, $allergy) = ($1, $2);
|
|
237
|
|
- # standardization
|
|
238
|
|
- $allergy =~ s/Kasvis/K/g;
|
|
239
|
|
- $allergy =~ s/([MLGK]|VL)([MLGK]|VL)/$1,$2/g;
|
|
240
|
|
- # spaces to commas
|
|
241
|
|
- $allergy =~ s/saatavana[: ]+(.*)$/eriks: $1/;
|
|
242
|
|
- $allergy =~ s/ +/,/g;
|
|
243
|
|
- # remove double commas
|
|
244
|
|
- $allergy =~ s/,+/,/g;
|
|
245
|
|
- # eriks: standardization
|
|
246
|
|
- $allergy =~ s/,?eriks:,?/, eriks: /g;
|
|
247
|
|
- # remove extra commas/spaces from beginning/end
|
|
248
|
|
- $allergy =~ s/^[, ]+//;
|
|
249
|
|
- $allergy =~ s/[, ]+$//;
|
|
250
|
|
- $part = "$food ($allergy)";
|
|
251
|
|
- }
|
|
252
|
|
-
|
|
253
|
|
- $output .= "<br />\n" if ($output ne "" && !$fries);
|
|
254
|
|
- if ($part =~ /Saatavana myös: (.*)/) {
|
|
255
|
|
- # standardize allergy stuff
|
|
256
|
|
- my $alt = $1;
|
|
257
|
|
- $alt =~ s/^\((.*)\)$/$1/;
|
|
258
|
|
- $alt =~ s/[, ]+/,/g;
|
|
259
|
|
- $alt =~ s/^,+//;
|
|
260
|
|
- $alt =~ s/,+$//;
|
|
261
|
|
- $part =~ s/\)[- ]*Saatavana myös:.*/, eriks: $alt)/;
|
|
262
|
|
- $part =~ s/[- ]*Saatavana myös:.*/ (eriks: $alt)/;
|
|
263
|
|
- }
|
|
264
|
|
- if ($part =~ /^(.*)(\([^\)]+\))$/) {
|
|
265
|
|
- my ($text, $allergy) = ($1, $2);
|
|
266
|
|
- if ($fries) {
|
|
267
|
|
- $output .= ", $text";
|
|
268
|
|
- } else {
|
|
269
|
|
- $output .= "$text <span class=\"allergy\">$allergy</span>";
|
|
270
|
|
- }
|
|
271
|
|
- $allergy =~ s/^\((.*)\)$/$1/;
|
|
272
|
|
- $allergy =~ s/ *eriks: //;
|
|
273
|
|
- my %this_allergies;
|
|
274
|
|
- foreach my $a (split(/[, ]/, $allergy)) {
|
|
275
|
|
- foreach my $al (@allergies) {
|
|
276
|
|
- if ($a eq $al) {
|
|
277
|
|
- $this_allergies{$a} = 1;
|
|
278
|
|
- last;
|
|
279
|
|
- }
|
|
280
|
|
- }
|
|
281
|
|
- }
|
|
282
|
|
- # is M=L always correct? not at least in all restaurants..
|
|
283
|
|
- #$this_allergies{"L"} = 1 if ($this_allergies{"M"});
|
|
284
|
|
- $this_allergies{"VL"} = 1 if ($this_allergies{"L"});
|
|
285
|
|
- foreach my $a (keys %this_allergies) {
|
|
286
|
|
- $total_allergies{$a}++;
|
|
287
|
|
- $maybe_allergies{$a}++;
|
|
288
|
|
- }
|
|
289
|
|
- if ($lazy_allergies =~ /M/) {
|
|
290
|
|
- # L might mean M
|
|
291
|
|
- if ($this_allergies{"L"} && !$this_allergies{"M"}) {
|
|
292
|
|
- $maybe_allergies{"M"}++;
|
|
293
|
|
- }
|
|
294
|
|
- }
|
|
295
|
|
- } else {
|
|
296
|
|
- if ($lazy_allergies eq "all") {
|
|
297
|
|
- # no allergy info, make everything maybe
|
|
298
|
|
- foreach my $a (@allergies) {
|
|
299
|
|
- $maybe_allergies{$a}++;
|
|
300
|
|
- }
|
|
301
|
|
- }
|
|
302
|
|
- $output .= $part;
|
|
303
|
|
- }
|
|
304
|
|
- }
|
|
305
|
|
- my $allergy_output = "";
|
|
306
|
|
- foreach my $a (@allergies) {
|
|
307
|
|
- if ($total_allergies{$a} == $part_count) {
|
|
308
|
|
- if (!defined($eatable_food_numbers{$a})) {
|
|
309
|
|
- $eatable_food_numbers{$a} = "";
|
|
310
|
|
- } else {
|
|
311
|
|
- $eatable_food_numbers{$a} .= ",";
|
|
312
|
|
- }
|
|
313
|
|
- $eatable_food_numbers{$a} .= $foodnum;
|
|
314
|
|
- } elsif ($maybe_allergies{$a} == $part_count) {
|
|
315
|
|
- if (!defined($maybe_eatable_food_numbers{$a})) {
|
|
316
|
|
- $maybe_eatable_food_numbers{$a} = "";
|
|
317
|
|
- } else {
|
|
318
|
|
- $maybe_eatable_food_numbers{$a} .= ",";
|
|
319
|
|
- }
|
|
320
|
|
- $maybe_eatable_food_numbers{$a} .= $foodnum;
|
|
321
|
|
- }
|
|
322
|
|
- }
|
|
323
|
|
- print $fout " <li id=\"f$foodnum\">$output</li>\n";
|
|
324
|
|
- $foodnum++;
|
|
325
|
|
- }
|
|
326
|
|
- print $fout "</ul>\n";
|
|
327
|
|
- }
|
|
328
|
|
- }
|
|
329
|
|
- # write allergy scripts
|
|
330
|
|
- print $fout '<script type="text/javascript" src="'.$global_prefix.'/ruoka.js"></script>';
|
|
331
|
|
- print $fout '<script type="text/javascript">';
|
|
332
|
|
- print $fout "var eatable_foods = [];";
|
|
333
|
|
- print $fout "var maybe_eatable_foods = [];";
|
|
334
|
|
- foreach my $a (@allergies) {
|
|
335
|
|
- print $fout "eatable_foods[\"$a\"] = [".$eatable_food_numbers{$a}."];\n";
|
|
336
|
|
- print $fout "maybe_eatable_foods[\"$a\"] = [".$maybe_eatable_food_numbers{$a}."];\n";
|
|
337
|
|
- }
|
|
338
|
|
- my @allergy_strings = map('"'.$_.'"', @allergies);
|
|
339
|
|
- print $fout "var allergies = [".join(",", @allergy_strings)."];\n";
|
|
340
|
|
- print $fout "var food_count = $foodnum\n";
|
|
341
|
|
- print $fout "window.onload = function() { set_allergies(); show_warning(); };\n";
|
|
342
|
|
- print $fout "</script>\n";
|
|
343
|
|
-
|
|
344
|
|
- print $fout "</div></div>$file_footer";
|
|
345
|
|
- close $fout;
|
|
346
|
|
-}
|
|
347
|
|
-
|
|
348
|
|
-sub write_all_days {
|
|
349
|
|
- my ($restaurants_ref, $prefix, $title) = @_;
|
|
350
|
|
- my $last_day = find_last_day_with_foods($restaurants_ref);
|
|
351
|
|
-
|
|
352
|
|
- for (my $day = 0; $day < 7; $day++) {
|
|
353
|
|
- my $outfname = $prefix.($day+1).".html";
|
|
354
|
|
- if ($day > $last_day) {
|
|
355
|
|
- unlink($outfname);
|
|
356
|
|
- next;
|
|
357
|
|
- }
|
|
358
|
|
- my $header = $day_names[$day]." - $title vko $max_week$max_week_daterange";
|
|
359
|
|
- write_day($day, $header, $outfname, $last_day, $restaurants_ref, $prefix);
|
|
360
|
|
- }
|
|
361
|
|
-}
|
|
362
|
|
-
|
|
363
|
|
-sub write_table {
|
|
364
|
|
- my ($restaurants_ref, $prefix, $title) = @_;
|
|
365
|
|
- my @restaurants = @{$restaurants_ref};
|
|
366
|
|
- my $last_day = find_last_day_with_foods($restaurants_ref);
|
|
367
|
|
-
|
|
368
|
|
- my $outfname = $prefix."table.html";
|
|
369
|
|
- open(my $fout, ">$outfname") || die ("Can't create file $outfname");
|
|
370
|
|
- my $header = "$title vko $max_week$max_week_daterange";
|
|
371
|
|
- print $fout "$file_header<h1>$header</h1>\n";
|
|
372
|
|
- print $fout "<div class=\"title\">\n";
|
|
373
|
|
- write_days_header($fout, -1, $last_day);
|
|
374
|
|
- write_prefix_header($fout, $prefix, 0);
|
|
375
|
|
- print $fout "</div><table border=\"1\"><tr><th>Päivä</th>";
|
|
376
|
|
- foreach my $r (@restaurants) {
|
|
377
|
|
- my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
|
|
378
|
|
- my ($title2, $url) = @{$info_ref};
|
|
379
|
|
- $url =~ s/&/ /g;
|
|
380
|
|
- print $fout "<th><a href=\"$url\">$title</a></th>";
|
|
381
|
|
- }
|
|
382
|
|
- print $fout "</tr>\n";
|
|
383
|
|
- for (my $day = 0; $day <= $last_day; $day++) {
|
|
384
|
|
- print $fout "<tr><td>".$day_names[$day]."</td>\n";
|
|
385
|
|
- foreach my $r (@restaurants) {
|
|
386
|
|
- my ($title, $open_hours, $week, $week_foods_ref, $info_ref) = @{$r};
|
|
387
|
|
- my @week_foods = @{$week_foods_ref};
|
|
388
|
|
- if (defined($week_foods[$day]) && ($week eq "" || $week == $max_week)) {
|
|
389
|
|
- print $fout "<td><ul>\n";
|
|
390
|
|
- foreach my $food (@{$week_foods[$day]}) {
|
|
391
|
|
- print $fout "<li>$food</li>";
|
|
392
|
|
- }
|
|
393
|
|
- print $fout "</ul></td>\n";
|
|
394
|
|
- } else {
|
|
395
|
|
- print $fout "<td></td>\n";
|
|
396
|
|
- }
|
|
397
|
|
- }
|
|
398
|
|
- print $fout "</tr>\n";
|
|
399
|
|
- }
|
|
400
|
|
- print $fout "</table>$file_footer";
|
|
401
|
|
- close $fout;
|
|
402
|
|
-}
|
|
403
|
|
-
|
|
404
|
|
-sub get_restaurants_sorted {
|
|
405
|
|
- my @restaurants = @_;
|
|
406
|
|
- my @out;
|
|
407
|
|
- foreach my $r (@restaurants) {
|
|
408
|
|
- push @out, $r if (@{@{$r}[4]}[3] eq "left");
|
|
409
|
|
- }
|
|
410
|
|
- foreach my $r (@restaurants) {
|
|
411
|
|
- push @out, $r if (@{@{$r}[4]}[3] eq "right");
|
|
412
|
|
- }
|
|
413
|
|
- foreach my $r (@restaurants) {
|
|
414
|
|
- my @e = @{@{$r}[4]};
|
|
415
|
|
- push @out, $r if ($e[3] eq "middle" && $e[1] !~ /TAMK/);
|
|
416
|
|
- }
|
|
417
|
|
- foreach my $r (@restaurants) {
|
|
418
|
|
- my @e = @{@{$r}[4]};
|
|
419
|
|
- push @out, $r if ($e[3] eq "middle" && $e[1] =~ /TAMK/);
|
|
420
|
|
- }
|
|
421
|
|
- return @out;
|
|
422
|
|
-}
|
|
423
|
|
-
|
|
424
|
|
-sub get_restaurants_with_prefix {
|
|
425
|
|
- my $prefix = shift;
|
|
426
|
|
- my @out;
|
|
427
|
|
- foreach my $r (@_) {
|
|
428
|
|
- my $name = @{$r}[0];
|
|
429
|
|
- if ($name =~ /^\($prefix\)/) {
|
|
430
|
|
- push @out, $r;
|
|
431
|
|
- }
|
|
432
|
|
- }
|
|
433
|
|
- return get_restaurants_sorted(@out);
|
|
434
|
|
-}
|
|
435
|
|
-
|
|
436
|
|
-my $tty_title = "TTY:n ruokalistat";
|
|
437
|
|
-my @tty = get_restaurants_with_prefix("TTY", @unordered);
|
|
438
|
|
-write_all_days(\@tty, "tty/", $tty_title);
|
|
439
|
|
-write_table(\@tty, "tty/", $tty_title);
|
|
440
|
|
-
|
|
441
|
|
-my $tay_title = "Tampereen yliopiston ruokalistat";
|
|
442
|
|
-my @tay = get_restaurants_with_prefix("TaY", @unordered);
|
|
443
|
|
-write_all_days(\@tay, "tay/", $tay_title);
|
|
444
|
|
-write_table(\@tay, "tay/", $tay_title);
|
|
445
|
|
-
|
|
446
|
|
-my $tays_title = "TAYS:n ruokalistat";
|
|
447
|
|
-my @tays = get_restaurants_with_prefix("TAYS", @unordered);
|
|
448
|
|
-write_all_days(\@tays, "tays/", $tays_title);
|
|
449
|
|
-write_table(\@tays, "tays/", $tays_title);
|
|
450
|
|
-
|
|
451
|
|
-foreach my $r (@unordered) {
|
|
452
|
|
- if (@{$r}[0] =~ /^\(TaY\)/) {
|
|
453
|
|
- @{@{$r}[4]}[3] = "left";
|
|
454
|
|
- }
|
|
455
|
|
- if (@{$r}[0] =~ /^\(TTY\)/) {
|
|
456
|
|
- @{@{$r}[4]}[3] = "right";
|
|
457
|
|
- }
|
|
458
|
|
- if (@{$r}[0] =~ /^\(TAYS\)/) {
|
|
459
|
|
- @{@{$r}[4]}[3] = "middle";
|
|
460
|
|
- }
|
|
461
|
|
-}
|
|
462
|
|
-
|
|
463
|
|
-my $all_title = "Tampereen yliopistojen ruokalistat";
|
|
464
|
|
-my @all_restaurants = get_restaurants_sorted(@unordered);
|
|
465
|
|
-# move fusion kitchen last
|
|
466
|
|
-my @fusion = splice(@all_restaurants, 1, 1);
|
|
467
|
|
-splice(@all_restaurants, 4, 0, @fusion);
|
|
468
|
|
-
|
|
469
|
|
-write_all_days(\@all_restaurants, "", $all_title);
|
|
470
|
|
-write_table(\@all_restaurants, "", $all_title);
|
Toni Fadjukoff