Mercurial > hg > egg-tcls

comparison fetch_food.tcl @ 258:599b90e41c03

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rename a script.
author Matti Hamalainen <ccr@tnsp.org>
date Fri, 23 Jan 2015 09:24:59 +0200
parents hae_ruoka.tcl@593874678e45
children 825cac46b1cb
comparison
equal deleted inserted replaced
257:4abc5366866c 258:599b90e41c03
1 #!/usr/bin/tclsh
2 #
3 # NOTICE! Change above path to correct tclsh binary path!
4 #
5 ##########################################################################
6 #
7 # RuokaLista fetcher v1.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
8 # (C) Copyright 2010-2011 Tecnic Software productions (TNSP)
9 #
10 # This script is freely distributable under GNU GPL (version 2) license.
11 #
12 ##########################################################################
13
14 # Path and filename of the data file, MUST BE SAME as in "ruoka.tcl"
15 set datafile "/home/niinuska/bot/data.ruoka"
16
17 # Use a HTTP proxy? (1 = yes, 0 = no)
18 set http_proxy 0
19
20 # HTTP proxy host address and port (only needed if use_proxy = 1)
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 />| |&nbsp;| |&#160;| |&raquo;|>>|&quot;|\"|&auml;|ä|&ouml;|ö|&Auml;|Ä|&Ouml;|Ö|&amp;|&|&lt;|<|&gt;|>|ä|ä|ö|ö|Ä|Ä" "|"]
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'><b>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai) \[0-9\]+\.\[0-9\]+</b></span><P>(\[^<\]+)</span>(.*)\$" $upage]
93 set umatches [regexp -nocase -inline -- "<span class='otsikko'><b>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai) +\[0-9\]+\.\[0-9\]+</b></span>(.*?)</span>(.*)$" $upage]
94 set nmatches [llength $umatches]
95 puts "[lindex $umatches 1]"
96 if {$nmatches > 3} {
97 # set umat [regexp -nocase -inline -- "^(.+?)<br>" [lindex $umatches 3]]
98 set umat [regexp -all -nocase -inline -- "(.\*\?)<br>" [lindex $umatches 2]]
99 set tmp ""
100 foreach {ukey udata} $umat {
101 set item [string trim [convert_ent $udata]]
102 if {[string length $item] > 0} {
103 lappend tmp $item
104 }
105 }
106 add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "]
107 }
108 set upage [lindex $umatches 3]
109 }
110
111 return 0
112 }
113
114
115 ##########################################################################
116 set kello [clock seconds]
117 set viikko [expr [clock format $kello -format "%W"] + 1]
118 set vuosi [clock format $kello -format "%Y"]
119
120 # Amica/OAMK tekniikan yksikkö
121 add_amica "http://www.amica.fi/kotkanpoika" "OAMK"
122
123 # Oulun yliopiston Unirestat
124 set str "http://www.uniresta.fi/2010/ruokalista_tulostettava.php?viikko=$viikko&vuosi=$vuosi&ravintola"
125
126 add_uniresta "$str=2" "Aularavintola"
127 add_uniresta "$str=3" "Discus"
128 add_uniresta "$str=4" "Julinia"
129 add_uniresta "$str=5" "Kastari"
130 add_uniresta "$str=6" "Snellmania"
131 add_uniresta "$str=7" "Pruxis"
132 add_uniresta "$str=10" "Vanilla"
133 add_uniresta "$str=11" "Minttu"
134
135
136 ##########################################################################
137 ### Open result datafile and save data
138 set tmpfname "$datafile.tmp"
139 if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} {
140 puts "Error opening $tmpfname for writing: $uerrmsg"
141 return 1
142 }
143
144 foreach {ukey udata} [array get entries] {
145 puts $outfile [join $udata "½"]
146 }
147
148 close $outfile
149 if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} {
150 puts "Error renaming $tmpfname to $datafile: $uerrmsg"
151 }