Ver código fonte

Initial commit of PNA site scripts.

Toni Fadjukoff 12 anos atrás
commit
3551713f03
9 arquivos alterados com 1254 adições e 0 exclusões
  1. 1 0
      .gitignore
  2. 242 0
      amica.pl
  3. 467 0
      food.pl
  4. 220 0
      juvenes.pl
  5. 169 0
      pky.pl
  6. 155 0
      sodexo.pl
  7. 0 0
      tay/.placeholder
  8. 0 0
      tays/.placeholder
  9. 0 0
      tty/.placeholder

+ 1 - 0
.gitignore Ver arquivo

@@ -0,0 +1 @@
1
+*.html

+ 242 - 0
amica.pl Ver arquivo

@@ -0,0 +1,242 @@
1
+use vars qw(@day_names);
2
+
3
+# erkkeri is gone - could remove a lot of this ugliness
4
+
5
+my $erkkeri_title = "(TTY) Amica Erkkeri";
6
+my @restaurant_info = (
7
+  [ "(TaY) Amica Minerva", "http://www.amica.fi/minerva", "", "middle" ]
8
+  #[ $erkkeri_title, "http://www.amica.fi/erkkeri", "", "left" ]
9
+);
10
+
11
+my ($parse_func, $day_id, $week, $erkkeri);
12
+my (@cur_day_foods, @week_foods);
13
+
14
+sub amica_parse_to_eof {
15
+}
16
+
17
+sub amica_finish_day {
18
+  push @week_foods, [@cur_day_foods];
19
+  @cur_day_foods = ();
20
+  $day_id = $day_id + 1;
21
+}
22
+
23
+sub utf8_to_8859 {
24
+  $_ = shift;
25
+
26
+  s/ä/ä/g;
27
+  s/ö/ö/g;
28
+  s/Ä/Ä/g;
29
+  s/Ö/Ö/g;
30
+  return $_;
31
+}
32
+
33
+sub amica_parse_line {
34
+  my $text = shift;
35
+  
36
+  $text =~ tr/\r\n\t/   /;
37
+  $text =~ s/( | )*$//;
38
+  $text =~ s/ *(\d+,\d+ *\/ *)?\d+,\d+ *$//;
39
+  $text =~ s/^( | )*//;
40
+  $text =~ s/( | )*$//;
41
+  $text =~ s/valinnan mukaan$//;
42
+  if ($text =~ /^(.*) \(([^\)]+)\)$/) {
43
+    my ($name, $allergy) = ($1, $2);
44
+    $name =~ s/( )*$//;
45
+    $allergy =~ s/\*veg\./ eriks: Ve/g;
46
+    $allergy =~ s/veg/Ve/gi;
47
+    $allergy =~ s/\*([A-Z]+)/ eriks: $1/;
48
+    return "$name ($allergy)\n";
49
+  } elsif ($text ne "") {
50
+    return "$text\n";
51
+  }
52
+  return "";
53
+}
54
+
55
+sub amica_parse_split {
56
+  my $text = shift;
57
+  
58
+  my $food = "";
59
+  for (;;) {
60
+    $i = index($text, ")");
61
+    last if ($i == -1);
62
+    
63
+    my $line = substr($text, 0, $i + 1);
64
+    $food .= amica_parse_line($line);
65
+    $text = substr($text, $i + 1);
66
+  }
67
+  $food .= amica_parse_line($text);
68
+  push @cur_day_foods, $food if ($food ne "");
69
+}
70
+
71
+sub amica_parse_more_food {
72
+  my $token = shift;
73
+  
74
+  if ($token->[0] eq 'T') {
75
+    my $text = utf8_to_8859($token->[1]);
76
+    my $next_day_name = $day_names[$day_id+1];
77
+    
78
+    if ($day_id < 6 && $text =~ /^$next_day_name\b/i) {
79
+      # day changed
80
+      amica_finish_day();
81
+    } else {
82
+      amica_parse_split($text);
83
+    }
84
+  } elsif ($token->[0] eq 'S' && $token->[1] eq 'h2') {
85
+    amica_finish_day();
86
+    $parse_func = \&amica_parse_to_eof;
87
+  }
88
+}
89
+
90
+sub amica_parse_first_day {
91
+  my $token = shift;
92
+  
93
+  if ($token->[0] eq 'T') {
94
+    for ($day_id = 0; $day_id < 7; $day_id++) {
95
+      my $dayname = $day_names[$i];
96
+      last if ($token->[1] =~ /^$dayname\b/i);
97
+    }
98
+    $day_id = 0 if ($day_id == 7);
99
+    $parse_func = \&amica_parse_more_food;
100
+  }
101
+}
102
+
103
+sub amica_parse_to_start {
104
+  my $token = shift;
105
+  
106
+  if ($token->[0] eq 'S' && $token->[1] eq 'p') {
107
+    $parse_func = \&amica_parse_first_day;
108
+  }
109
+}
110
+
111
+sub get_week {
112
+  my ($mday, $mon) = @_;
113
+
114
+  my @l = localtime;
115
+  my @l2 = (0, 0, 0, $mday, $mon-1, $l[5], 0, 0, -1);
116
+  @l = localtime(mktime(@l2));
117
+  return strftime("%V", @l);
118
+}
119
+
120
+sub amica_parse_date {
121
+  my $token = shift;
122
+  
123
+  if ($token->[0] eq 'T') {
124
+    my $text = $token->[1];
125
+    if ($text =~ /^(\d\d\d\d)-(\d?\d)-(\d?\d) /) {
126
+      my ($mday, $mon) = ($3, $2);
127
+      $week = get_week($mday, $mon);
128
+    }
129
+  } elsif ($token->[0] eq 'E' && $token->[1] eq 'h2') {
130
+    $parse_func = \&amica_parse_to_start;
131
+  }
132
+}
133
+
134
+sub amica_parse_to_date {
135
+  my $token = shift;
136
+  
137
+  if ($token->[0] eq 'S' && $token->[1] eq 'h2') {
138
+    my %attrs = %{$token->[2]};
139
+    if ($attrs{'id'} =~ /HeadingMenu/) {
140
+      $parse_func = \&amica_parse_date;
141
+    }
142
+  }
143
+}
144
+
145
+sub parse_amica {
146
+  my ($fname, $info_ref) = @_;
147
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
148
+  my $title = @{$info_ref}[0];
149
+  
150
+  $week = "";
151
+  $day_id = 0;
152
+  @cur_day_foods = ();
153
+  @week_foods = ();
154
+
155
+  $parse_func = \&amica_parse_to_date;
156
+  while (my $token = $p->get_token) {
157
+    &$parse_func($token);
158
+  }
159
+  return [ $title, "", $week, [ @week_foods ], $info_ref ];
160
+}
161
+
162
+sub parse_amica_get_finnish_url {
163
+  my ($fname) = @_;
164
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
165
+
166
+  my @l = localtime;
167
+  my $this_week = strftime("%V", @l);
168
+
169
+  my $state = 0;
170
+  my $last_url = "";
171
+  my $week = "";
172
+  while (my $token = $p->get_token) {
173
+    if ($token->[0] eq 'S' && $token->[1] eq 'meta') {
174
+      my %attrs = %{$token->[2]};
175
+      if ($attrs{'name'} eq "TITLE") {
176
+        if ($attrs{'content'} =~ /(\d+)\.(\d+)\.? *- *(\d+)\.(\d+)/) {
177
+          my ($mday, $mon) = ($1, $2);
178
+          $week = get_week($mday, $mon);
179
+        } elsif ($attrs{'content'} =~ /(\d+)\.? *- *(\d+)\.(\d+)/) {
180
+          my ($mday, $mon) = ($1, $3);
181
+          $week = get_week($mday, $mon);
182
+        }
183
+	return "" if ($attrs{'content'} !~ /English/i && $week == $this_week);
184
+      }
185
+    } elsif ($token->[0] eq 'S' && $token->[1] eq 'a') {
186
+      my %attrs = %{$token->[2]};
187
+      $last_url = $attrs{'href'};
188
+    } elsif ($token->[0] eq 'T' && $token->[1] =~ /^ruokalista (\d+)\.(\d+)\.? *- *(\d+)\.(\d+)/i) {
189
+      my ($mday, $mon) = ($1, $2);
190
+      $week = get_week($mday, $mon);
191
+      return $last_url if ($week == $this_week);
192
+    } elsif ($token->[0] eq 'T' && $token->[1] =~ /^ruokalista (\d+)\.? *- *(\d+)\.(\d+)/i) {
193
+      my ($mday, $mon) = ($1, $3);
194
+      $week = get_week($mday, $mon);
195
+      return $last_url if ($week == $this_week);
196
+    } elsif ($token->[0] eq 'T' && $token->[1] =~ /^ruokalista (viikko|vko) (\d+)/i) {
197
+      $week = $2;
198
+      return $last_url if ($week == $this_week);
199
+    }
200
+  }
201
+  return "";
202
+}
203
+
204
+sub parse_amica_url {
205
+  my ($fname) = @_;
206
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
207
+  
208
+  my $state = 0;
209
+  while (my $token = $p->get_token) {
210
+    if ($token->[0] eq 'S') {
211
+      my %attrs = %{$token->[2]};
212
+      if ($token->[1] eq 'td' && $attrs{'title'} eq 'Ruokalistat' && $state == 0) {
213
+	$state = 1;
214
+      } elsif ($token->[1] eq 'a' && $state == 1) {
215
+	return $attrs{'href'};
216
+      }
217
+    }
218
+  }
219
+  return "";
220
+}
221
+
222
+sub get_amica_restaurant {
223
+  my $use_old = shift;
224
+  my $count = 0;
225
+  my @restaurants = ();
226
+  foreach my $i (@restaurant_info) {
227
+    my @info = @{$i};
228
+    my $temp_fname = "amica$count.temp.html";
229
+    my $url = $info[1];
230
+    if (!-f $temp_fname || !$use_old) {
231
+      system("wget -q --timeout=10 -O $temp_fname.tmp '$url' && mv $temp_fname.tmp $temp_fname") if ($url ne "");
232
+    }
233
+    if (-f $temp_fname) {
234
+      $info[1] = $url;
235
+      push @restaurants, parse_amica($temp_fname, \@info);
236
+    }
237
+    $count++;
238
+  }
239
+  return @restaurants;
240
+}
241
+
242
+1;

+ 467 - 0
food.pl Ver arquivo

@@ -0,0 +1,467 @@
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);

+ 220 - 0
juvenes.pl Ver arquivo

@@ -0,0 +1,220 @@
1
+use vars qw(@day_names);
2
+
3
+my $pinni_title = "(TaY) Café Pinni";
4
+my $bio_title = "(TAYS) Bio";
5
+my $kliininen_title = "(TAYS) Arvo";
6
+my $kliininen_fusion_title = "(TAYS) Arvo Fusion Kitchen";
7
+my $zip_salaattibaari_title = "(TTY) Zip Salaattibaari";
8
+my @restaurant_info = (
9
+  [ "(TaY) Yliopiston Ravintola", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Yliopiston_Ravintola", "M", "left" ],
10
+  [ "(TaY) Yliopiston Ravintola / Salaattibaari", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Yliopiston_Ravintola/Salaattibaari", "", "left" ],
11
+  [ "(TaY) Fusion Kitchen", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Yliopiston_Ravintola/Fusion_Kitchen", "", "left" ],
12
+  [ $pinni_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY__Caf__Pinni", "M", "middle" ],
13
+  [ $bio_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY_Kauppi__Medica_Bio", "M", "left" ],
14
+  [ $kliininen_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY_Kauppi__Medica_Arvo", "M", "left" ],
15
+  [ $kliininen_fusion_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TaY_Kauppi__Medica_Arvo/Fusion_Kitchen", "M", "left" ],
16
+  [ "(TTY) Newton", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Newton", "", "left" ],
17
+  [ "(TTY) Zip", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Zip", "", "right" ],
18
+  [ "(TTY) Edison", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Edison", "", "middle" ],
19
+  [ $zip_salaattibaari_title, "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Zip/Salaattibaari", "", "right" ],
20
+  [ "(TTY) Pastabaari", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Caf____Fast_Voltti/Pastabaari", "", "middle" ],
21
+  [ "(TTY) Fast Voltti", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Caf____Fast_Voltti", "", "middle" ],
22
+  [ "(TTY) Fusion Kitchen", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TTY__Newton/Fusion_Kitchen", "", "left" ],
23
+  [ "(TAMK) Dot", "http://www.juvenes.fi/Suomeksi/Ravintolat_ja_kahvilat/Opiskelijaravintolat/_TAMK__Dot__Ziberia_", "", "middle" ]
24
+);
25
+
26
+my @restaurants;
27
+my ($parse_func, $week, $open_hours, $day_id, $cur_title);
28
+my ($cur_food, @cur_day_foods, @week_foods);
29
+
30
+sub parse_to_eof {
31
+}
32
+
33
+sub parse_skip_to_end_of_div {
34
+  my $token = shift;
35
+  
36
+  if ($token->[0] eq 'E' && $token->[1] eq 'div') {
37
+    $parse_func = \&parse_more_food;
38
+  }
39
+}
40
+
41
+sub parse_open_hours_begin {
42
+  my $token = shift;
43
+
44
+  if ($token->[0] eq 'T') {
45
+    if ($token->[1] =~ /^Aukiolo/) {
46
+      $parse_func = \&parse_open_hours_end;
47
+    }
48
+  }
49
+}
50
+
51
+sub parse_open_hours_end {
52
+  my $token = shift;
53
+
54
+  if ($token->[0] eq 'T') {
55
+    my $text = $token->[1];
56
+    if ($text eq 'Erityisruokavaliot') {
57
+      $parse_func = \&parse_to_eof;
58
+    } else {
59
+      $text =~ s/\n//g;
60
+      $text =~ s/ +$//;
61
+      $open_hours .= "$text\n" if ($text ne "");
62
+    }
63
+  }
64
+}
65
+
66
+sub finish_food {
67
+  chomp $cur_food;
68
+  if ($cur_food =~ /Liha paniini.*tai Kasvis paniini/i && $cur_title eq $pinni_title) {
69
+    # you get this every day, ignore
70
+  } else {
71
+    push @cur_day_foods, $cur_food if ($cur_food ne "");
72
+  }
73
+  $cur_food = "";
74
+}
75
+
76
+sub finish_day {
77
+  push @week_foods, [@cur_day_foods];
78
+  @cur_day_foods = ();
79
+  $day_id = $day_id + 1;
80
+}
81
+
82
+sub parse_more_food {
83
+  my $token = shift;
84
+  
85
+  if ($token->[0] eq 'S') {
86
+    my %attrs = %{$token->[2]};
87
+    if ($token->[1] eq 'div') {
88
+      if ($attrs{'style'} =~ /display: *none/) {
89
+	# infobox, skip
90
+	$parse_func = \&parse_skip_to_end_of_div;
91
+      } elsif ($attrs{'class'} eq 'Column') {
92
+	# end of food
93
+	finish_food();
94
+	finish_day();
95
+	$parse_func = \&parse_open_hours_begin;
96
+      }
97
+    } elsif ($token->[1] eq 'br') {
98
+      if ($br_is_new_food) {
99
+	finish_food();
100
+      } else {
101
+	$cur_food .= "\n" if ($cur_food ne "" && substr($cur_food, -1) ne "\n");
102
+      }
103
+    }
104
+  } elsif ($token->[0] eq 'T') {
105
+    my $text = $token->[1];
106
+    if ($day_id < 6 && $text eq $day_names[$day_id+1]) {
107
+      # day changed
108
+      finish_food();
109
+      finish_day();
110
+    } elsif ($text eq "&nbsp;") {
111
+      # next food
112
+      finish_food();
113
+    } else {
114
+      $text =~ tr/\r\n\t/   /;
115
+      $text =~ s/ +/ /g;
116
+      $text =~ s/^ +//;
117
+      $text =~ s/^\.+//;
118
+      $text =~ s/ +$//;
119
+      $text =~ s/sisältää ([^, \)]+)/sis.$1/ig;
120
+      $cur_food .= $text;
121
+    }
122
+  }
123
+}
124
+
125
+sub parse_monday {
126
+  my $token = shift;
127
+  
128
+  if ($token->[0] eq 'T') {
129
+    if ($token->[1] eq $day_names[0]) {
130
+      $parse_func = \&parse_more_food;
131
+    }
132
+  }
133
+}
134
+
135
+sub parse_week {
136
+  my $token = shift;
137
+  
138
+  if ($token->[0] eq 'T') {
139
+    if ($token->[1] =~ /Viikko: (\d+)/) {
140
+      $week = $1;
141
+      $parse_func = \&parse_monday;
142
+    }
143
+  }
144
+}
145
+
146
+sub parse_juvenes {
147
+  my ($fname, $info_ref) = @_;
148
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
149
+
150
+  my $title = @{$info_ref}[0];
151
+  $week = "";
152
+  $open_hours = "";
153
+  $day_id = 0;
154
+  $cur_food = "";
155
+  @cur_day_foods = ();
156
+  @week_foods = ();
157
+  $br_is_new_food = $title eq $zip_salaattibaari_title;
158
+  $cur_title = $title;
159
+  
160
+  $parse_func = \&parse_week;
161
+  while (my $token = $p->get_token) {
162
+    &$parse_func($token);
163
+  }
164
+  push @restaurants, [ $title, $open_hours, $week, [ @week_foods ], $info_ref ];
165
+}
166
+
167
+sub can_merge_bio_kliininen {
168
+  my $day = shift;
169
+
170
+  my $bio_foods = "";
171
+  my $kliininen_foods = "";
172
+  my $food_dest;
173
+  foreach my $r (@restaurants) {
174
+    my ($title, $open_hours, $week, $week_foods_ref) = @{$r};
175
+    if ($title eq $bio_title) {
176
+      $food_dest = \$bio_foods;
177
+    } elsif ($title eq $kliininen_title) {
178
+      $food_dest = \$kliininen_foods;
179
+    } else {
180
+      next;
181
+    }
182
+    my @week_foods = @{$week_foods_ref};
183
+    foreach my $food (@{$week_foods[$day]}) {
184
+      ${$food_dest} .= "$food\n";
185
+    }
186
+  }
187
+  return $bio_foods eq $kliininen_foods;
188
+}
189
+
190
+sub try_merge_bio_kliininen {
191
+  my ($title_ref, $day) = @_;
192
+  my $title = $$title_ref;
193
+
194
+  if ($title eq $bio_title && can_merge_bio_kliininen($day)) {
195
+    $$title_ref .= " + Kliininen";
196
+  } elsif ($title eq $kliininen_title && can_merge_bio_kliininen($day)) {
197
+    return 1;
198
+  }
199
+  return 0;
200
+}
201
+
202
+sub get_juvenes_restaurants {
203
+  my $use_old = shift;
204
+  my $count = 0;
205
+  foreach my $i (@restaurant_info) {
206
+    my @info = @{$i};
207
+    my $temp_fname = "juvenes$count.temp.html";
208
+    my $url = $info[1];
209
+    if (!-f $temp_fname || !$use_old) {
210
+      system("wget -q --timeout=10 -O $temp_fname.tmp '$url' && mv $temp_fname.tmp $temp_fname");
211
+    }
212
+    if (-f $temp_fname) {
213
+      parse_juvenes($temp_fname, \@info);
214
+    }
215
+    $count++;
216
+  }
217
+  return @restaurants;
218
+}
219
+
220
+1;

+ 169 - 0
pky.pl Ver arquivo

@@ -0,0 +1,169 @@
1
+use vars qw(@day_names);
2
+
3
+my @short_day_names = ( "ma", "ti", "ke", "to", "pe", "la", "su" );
4
+
5
+#my $pky_url = "http://www.pky.fi/lounaslistat";
6
+my $pky_url = "http://www.pikante.fi/index.php/Pikante/lounaaksi-t%C3%A4n%C3%A4%C3%A4n.html";
7
+
8
+my @restaurant_info = (
9
+  [ "(TAYS) Finn-Medi", "$pky_url", "all", "middle" ],
10
+  [ "(TAYS) Café Olive", "$pky_url", "all", "middle" ],
11
+  [ "(TAYS) Ellipsi", "$pky_url", "all", "middle" ]
12
+);
13
+
14
+my ($parse_func, $day_id, $week);
15
+my (@cur_day_foods, @week_foods);
16
+my ($show_next_week, $content_title);
17
+
18
+sub utf8_to_8859 {
19
+  $_ = shift;
20
+
21
+  s/ //g;
22
+  s/é/é/g;
23
+  s/ä/ä/g;
24
+  s/ö/ö/g;
25
+  s/Ä/Ä/g;
26
+  s/Ö/Ö/g;
27
+  return $_;
28
+}
29
+
30
+sub pky_finish_day {
31
+  push @week_foods, [@cur_day_foods];
32
+  @cur_day_foods = ();
33
+  $day_id = $day_id + 1;
34
+}
35
+
36
+sub pky_parse_more_food {
37
+  my $token = shift;
38
+  
39
+  if ($token->[0] eq 'T') {
40
+    my $text = utf8_to_8859($token->[1]);
41
+    foreach my $text (split("/", $text)) {
42
+      push @cur_day_foods, $text if ($text ne "");
43
+    }
44
+  } elsif ($token->[0] eq 'E') {
45
+    if ($token->[1] eq 'tr') {
46
+      pky_finish_day();
47
+      $parse_func = \&pky_parse_day_td;
48
+    }
49
+  }
50
+}
51
+
52
+sub pky_parse_day_td {
53
+  my $token = shift;
54
+  
55
+  if ($token->[0] eq 'E') {
56
+    if ($token->[1] eq 'td') {
57
+      $parse_func = \&pky_parse_more_food;
58
+    } elsif ($token->[1] eq 'table') {
59
+      $parse_func = \&pky_parse_to_week;
60
+    }
61
+  } elsif ($token->[0] eq 'T') {
62
+    my $text = $token->[1];
63
+    my $i = 0;
64
+    foreach my $day (@short_day_names) {
65
+      if ($text =~ /$day$/i) {
66
+	while ($day_id < $i) {
67
+	  push @week_foods, [ ];
68
+	  $day_id++;
69
+	}
70
+	last;
71
+      }
72
+      $i++;
73
+    }
74
+  }
75
+}
76
+
77
+sub pky_parse_to_monday {
78
+  my $token = shift;
79
+  
80
+  if ($token->[0] eq 'S' && $token->[1] eq 'tr') {
81
+    $parse_func = \&pky_parse_day_td;
82
+  } elsif ($token->[0] eq 'E' && $token->[1] eq 'table') {
83
+    $parse_func = \&pky_parse_to_week;
84
+  }
85
+}
86
+
87
+sub want_second_week {
88
+  my $week = shift;
89
+
90
+  return 1 if $day_id == 0; # week didn't start from beginning
91
+  
92
+  my @l = localtime;
93
+  my $this_week = strftime("%V", @l);
94
+  return $week == $this_week || ($l[6] == 6 && ($week%52)+1 == $this_week);
95
+}
96
+
97
+sub pky_parse_to_eof {
98
+}
99
+
100
+sub pky_parse_to_week {
101
+  my $token = shift;
102
+  
103
+  if ($token->[0] eq 'T' && $token->[1] =~ /Viikko (\d+)/) {
104
+    my $parsed_week = $1;
105
+    # earlier version could have shown two tables for two weeks
106
+    # sometimes. but the new version? dunno yet..
107
+    #if ($week == 0 || $show_next_week) {
108
+    if ($week == 0) {
109
+      $week = $parsed_week;
110
+      $day_id = 0;
111
+      @cur_day_foods = ();
112
+      @week_foods = ();
113
+      $parse_func = \&pky_parse_to_monday;
114
+    } else {
115
+      $parse_func = \&pky_parse_to_eof;
116
+    }
117
+  }
118
+}
119
+
120
+sub pky_parse_to_title {
121
+  my $token = shift;
122
+  
123
+  if ($token->[0] eq 'T') {
124
+    my $text = utf8_to_8859($token->[1]);
125
+    if ($text =~ /$content_title.*lounasaika/) {
126
+      $parse_func = \&pky_parse_to_week;
127
+    }
128
+  }
129
+}
130
+
131
+sub parse_pky {
132
+  my ($fname, $info_ref) = @_;
133
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
134
+  
135
+  my $title = @{$info_ref}[0];
136
+  $week = 0;
137
+  
138
+  $content_title = $title;
139
+  $content_title =~ s/^\(TAYS\) //;
140
+
141
+  $parse_func = \&pky_parse_to_title;
142
+  while (my $token = $p->get_token) {
143
+    &$parse_func($token);
144
+  }
145
+  return [ $title, "", $week, [ @week_foods ], $info_ref ];
146
+}
147
+
148
+sub get_pky_restaurants {
149
+  my $use_old;
150
+  ($use_old, $show_next_week) = @_;
151
+
152
+  my $temp_fname = "pky.temp.html";
153
+  if (!-f $temp_fname || !$use_old) {
154
+    system("wget -q --timeout=10 -O $temp_fname.tmp '$pky_url' && mv $temp_fname.tmp $temp_fname");
155
+  }
156
+  
157
+  my @restaurants = ();
158
+  if (-f $temp_fname) {
159
+    my $count = 0;
160
+    foreach my $i (@restaurant_info) {
161
+      my @info = @{$i};
162
+      push @restaurants, parse_pky($temp_fname, \@info);
163
+      $count++;
164
+    }
165
+  }
166
+  return @restaurants;
167
+}
168
+
169
+1;

+ 155 - 0
sodexo.pl Ver arquivo

@@ -0,0 +1,155 @@
1
+use vars qw(@day_names);
2
+
3
+my @restaurant_info = (
4
+  #[ "(TaY) Sodexo Linna", "http://www.sodexo.fi/fi-FI/linna/lounas/", "right" ],
5
+  #[ "(TTY) Sodexo Erkkeri", "http://www.sodexo.fi/fi-FI/erkkeri/lounas/", "left" ]
6
+  [ "(TaY) Sodexo Linna", "http://www.sodexo.fi/linna", "right" ],
7
+  [ "(TTY) Sodexo Erkkeri", "http://www.sodexo.fi/erkkeri", "left" ]
8
+);
9
+
10
+my ($cur_text, $cur_title, $parse_func, $day_id, $week);
11
+my (@cur_day_foods, @week_foods);
12
+
13
+sub sodexo_finish_day {
14
+  push @week_foods, [@cur_day_foods];
15
+  @cur_day_foods = ();
16
+  $day_id = $day_id + 1;
17
+}
18
+
19
+sub utf8_to_8859 {
20
+  $_ = shift;
21
+
22
+  s/ä/ä/g;
23
+  s/ö/ö/g;
24
+  s/Ä/Ä/g;
25
+  s/Ö/Ö/g;
26
+  return $_;
27
+}
28
+
29
+sub sodexo_parse_finish {
30
+}
31
+
32
+sub sodexo_parse_after_food {
33
+  my $token = shift;
34
+
35
+  if ($token->[0] eq 'E' && $token->[1] eq 'tbody') {
36
+    sodexo_finish_day();
37
+    $parse_func = \&sodexo_parse_finish;
38
+  } elsif ($token->[0] eq 'S' && $token->[1] eq 'td') {
39
+    $parse_func = \&sodexo_parse_to_food;
40
+  } elsif ($token->[0] eq 'S' && $token->[1] eq 'th') {
41
+    sodexo_finish_day();
42
+    $parse_func = \&sodexo_parse_to_food;
43
+  }
44
+}
45
+
46
+sub sodexo_finish_food {
47
+  if ($cur_text ne "") {
48
+    push @cur_day_foods, "$cur_title ($cur_text)";
49
+  } else {
50
+    push @cur_day_foods, "$cur_title";
51
+  }
52
+  $parse_func = \&sodexo_parse_after_food;
53
+}
54
+
55
+sub sodexo_parse_allergy {
56
+  my $token = shift;
57
+
58
+  if ($token->[0] eq 'T' && !($token->[1] =~ /\s*\/\s*/)) {
59
+    my $text = $token->[1];
60
+    $text =~ s/^\s+//;
61
+    $text =~ s/\s+$//;
62
+    $cur_text .= ", " if $cur_text ne "";
63
+    $cur_text .= $text;
64
+  } elsif ($token->[0] eq 'E' && $token->[1] eq 'td') {
65
+    sodexo_finish_food();
66
+  }
67
+}
68
+
69
+sub sodexo_parse_to_allergy {
70
+  my $token = shift;
71
+
72
+  if ($token->[0] eq 'S' && $token->[1] eq 'td') {
73
+    my %attrs = %{$token->[2]};
74
+    if ($attrs{'class'} eq 'food-properties') {
75
+      $parse_func = \&sodexo_parse_allergy;
76
+    }
77
+  }
78
+}
79
+
80
+sub sodexo_parse_food {
81
+  my $token = shift;
82
+
83
+  if ($token->[0] eq 'T' && $token->[1] =~ /\S/) {
84
+     $cur_title = utf8_to_8859($token->[1]);
85
+     $parse_func = \&sodexo_parse_to_allergy;
86
+  }
87
+}
88
+
89
+sub sodexo_parse_to_food {
90
+  my $token = shift;
91
+  if ($token->[0] eq 'S' && $token->[1] eq "td") {
92
+    my %attrs = %{$token->[2]};
93
+    if ($attrs{'class'} eq "food-desc") {
94
+      $cur_title = '';
95
+      $cur_text = '';
96
+      $parse_func = \&sodexo_parse_food;
97
+    }
98
+  }
99
+}
100
+
101
+sub sodexo_parse_week {
102
+  my $token = shift;
103
+  if ($token->[0] eq 'T' && $token->[1] =~ /Viikko (\d+)/) {
104
+    $week = $1;
105
+    $parse_func = \&sodexo_parse_to_food;
106
+  }
107
+}
108
+
109
+sub sodexo_parse_to_week {
110
+  my $token = shift;
111
+  if ($token->[0] eq 'S' && $token->[1] eq 'div') {
112
+    my %attrs = %{$token->[2]};
113
+    if ($attrs{'class'} eq "list-date") {
114
+      $parse_func = \&sodexo_parse_week;
115
+    }
116
+  }
117
+}
118
+
119
+sub parse_sodexo {
120
+  my ($fname, $info_ref) = @_;
121
+  my $title = @{$info_ref}[0];
122
+  my $url = @{$info_ref}[1];
123
+  my $align = @{$info_ref}[2];
124
+  my $p = HTML::TokeParser->new($fname) or die("Can't open file $fname");
125
+
126
+  $week = "";
127
+  $day_id = 0;
128
+  @cur_day_foods = ();
129
+  @week_foods = ();
130
+
131
+  $parse_func = \&sodexo_parse_to_week;
132
+  while (my $token = $p->get_token) {
133
+    &$parse_func($token);
134
+  }
135
+  return [ $title, "", $week, [ @week_foods ], [ $title, $url, "M", $align ] ];
136
+}
137
+
138
+sub get_sodexo_restaurants {
139
+  my $use_old = shift;
140
+  my $count = 0;
141
+  my @restaurants = ();
142
+  foreach my $i (@restaurant_info) {
143
+    my @info = @{$i};
144
+    my $temp_fname = "sodexo$count.temp.html";
145
+    my $url = $info[1];
146
+    if (!-f $temp_fname || !$use_old) {
147
+      system("wget -q --timeout=10 -O $temp_fname.tmp '$url' && mv $temp_fname.tmp $temp_fname");
148
+      return undef if (!-f $temp_fname);
149
+    }
150
+    push @restaurants, parse_sodexo($temp_fname, \@info);
151
+  }
152
+  return @restaurants;
153
+}
154
+
155
+1;

+ 0 - 0
tay/.placeholder Ver arquivo


+ 0 - 0
tays/.placeholder Ver arquivo


+ 0 - 0
tty/.placeholder Ver arquivo