|
0
|
1 #!/usr/bin/tclsh
|
|
1
|
2 #
|
|
|
3 # NOTICE! Change above path to correct tclsh binary path!
|
|
|
4 #
|
|
0
|
5 ##########################################################################
|
|
|
6 #
|
|
|
7 # RuokaLista fetcher v1.0 by ccr/TNSP <ccr@tnsp.org>
|
|
|
8 # (C) Copyright 2010 Tecnic Software productions (TNSP)
|
|
|
9 #
|
|
1
|
10 # This script is freely distributable under GNU GPL (version 2) license.
|
|
|
11 #
|
|
0
|
12 ##########################################################################
|
|
|
13
|
|
|
14 # Datatiedosto, oltava sama kuin ruoka.tcl:n vastaava asetus
|
|
|
15 set datafile "/home/niinuska/bot/data.ruoka"
|
|
|
16
|
|
|
17 # Käytä HTTP proxya? 1 = kyllä, 0 = ei
|
|
|
18 set http_proxy 0
|
|
|
19
|
|
|
20 # HTTP proxyn osoite ja portti
|
|
|
21 set http_proxy_host "cache.inet.fi"
|
|
|
22 set http_proxy_port 800
|
|
|
23
|
|
|
24
|
|
|
25 ##############################################################################
|
|
|
26 set html_ent [split "\n| |\r| |<br />| | | | | |»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"]
|
|
|
27
|
|
|
28 package require http
|
|
|
29 ::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5"
|
|
|
30 if {$http_proxy != 0} {
|
|
|
31 ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port
|
|
|
32 }
|
|
|
33
|
|
|
34
|
|
|
35 proc convert_ent {udata} {
|
|
|
36 global html_ent
|
|
|
37 return [string map $html_ent $udata]
|
|
|
38 }
|
|
|
39
|
|
|
40
|
|
|
41 proc add_entry {uname uday udate udesc} {
|
|
|
42 global entries
|
|
|
43 set utest "$uname:$udate"
|
|
|
44 if {[catch {set utmp $entries($utest)}]} {
|
|
|
45 set entries($utest) [list $uname $uday $udate $udesc]
|
|
|
46 }
|
|
|
47 }
|
|
|
48
|
|
|
49
|
|
|
50 proc add_amica {datauri dataname} {
|
|
|
51 if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
|
|
|
52 puts "Error getting $datauri: $uerrmsg"
|
|
|
53 return 1
|
|
|
54 }
|
|
|
55
|
|
|
56 set upage [::http::data $utoken]
|
|
|
57 ::http::cleanup $utoken
|
|
|
58
|
|
|
59 set nmatches 1
|
|
|
60 while {$nmatches > 0} {
|
|
|
61 set umatches [regexp -nocase -inline -- "<strong>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai)</strong></td>.?.?<td colspan=\"2\"><strong>(\[^<\]+)</strong></td>(.*)\$" $upage]
|
|
|
62 set nmatches [llength $umatches]
|
|
|
63 if {$nmatches > 3} {
|
|
|
64 set umat [regexp -nocase -inline -- "^(.+?)(<td colspan=\"3\">|</tbody>)" [lindex $umatches 3]]
|
|
|
65 set umat [regexp -all -nocase -inline -- "<td colspan=\"\[78\]\">(.\*\?)</td>" [lindex $umat 1]]
|
|
|
66 set tmp ""
|
|
|
67 foreach {ukey udata} $umat {
|
|
|
68 set item [string trim [convert_ent $udata]]
|
|
|
69 if {[string length $item] > 0} {
|
|
|
70 lappend tmp $item
|
|
|
71 }
|
|
|
72 }
|
|
|
73 add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "]
|
|
|
74 }
|
|
|
75 set upage [lindex $umatches 3]
|
|
|
76 }
|
|
|
77
|
|
|
78 return 0
|
|
|
79 }
|
|
|
80
|
|
|
81 proc add_uniresta {datauri dataname} {
|
|
|
82 if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
|
|
|
83 puts "Error getting $datauri: $uerrmsg"
|
|
|
84 return 1
|
|
|
85 }
|
|
|
86
|
|
|
87 set upage [::http::data $utoken]
|
|
|
88 ::http::cleanup $utoken
|
|
|
89
|
|
|
90 set nmatches 1
|
|
|
91 while {$nmatches > 0} {
|
|
|
92 set umatches [regexp -nocase -inline -- "<span class='otsikko'>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai) +(\[^<\]+)</span>(.*)\$" $upage]
|
|
|
93 set nmatches [llength $umatches]
|
|
|
94 if {$nmatches > 3} {
|
|
|
95 set umat [regexp -nocase -inline -- "^(.+?)<br /><br /><br />" [lindex $umatches 3]]
|
|
|
96 set umat [regexp -all -nocase -inline -- "(.\*\?)<br>" [lindex $umat 1]]
|
|
|
97 set tmp ""
|
|
|
98 foreach {ukey udata} $umat {
|
|
|
99 set item [string trim [convert_ent $udata]]
|
|
|
100 if {[string length $item] > 0} {
|
|
|
101 lappend tmp $item
|
|
|
102 }
|
|
|
103 }
|
|
|
104 add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "]
|
|
|
105 }
|
|
|
106 set upage [lindex $umatches 3]
|
|
|
107 }
|
|
|
108
|
|
|
109 return 0
|
|
|
110 }
|
|
|
111
|
|
|
112
|
|
|
113 ##############################################################################
|
|
|
114 # Amica/OAMK tekniikan yksikkö
|
|
|
115 add_amica "http://www.amica.fi/kotkanpoika" "OAMK"
|
|
|
116
|
|
|
117 # Oulun yliopiston Unirestat
|
|
|
118 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=2" "Aularavintola"
|
|
|
119 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=3" "Discus"
|
|
|
120 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=4" "Julinia"
|
|
|
121 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=5" "Kastari"
|
|
|
122 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=6" "Snellmania"
|
|
|
123 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=7" "Pruxis"
|
|
|
124 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=10" "Vanilla"
|
|
|
125 add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=11" "Minttu"
|
|
|
126
|
|
|
127
|
|
|
128 ##############################################################################
|
|
|
129 ### Open result datafile and save data
|
|
|
130 set tmpfname "$datafile.tmp"
|
|
|
131 if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} {
|
|
|
132 puts "Error opening $tmpfname for writing: $uerrmsg"
|
|
|
133 return 1
|
|
|
134 }
|
|
|
135
|
|
|
136 foreach {ukey udata} [array get entries] {
|
|
|
137 puts $outfile [join $udata "½"]
|
|
|
138 }
|
|
|
139
|
|
|
140 close $outfile
|
|
|
141 if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} {
|
|
|
142 puts "Error renaming $tmpfname to $datafile: $uerrmsg"
|
|
|
143 }
|
