Mercurial > hg > egg-tcls
annotate fetch_food.tcl @ 424:825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Sun, 08 Jan 2017 03:55:55 +0200 |
| parents | 599b90e41c03 |
| children |
| rev | line source |
|---|---|
| 0 | 1 #!/usr/bin/tclsh |
| 1 | 2 # |
| 3 # NOTICE! Change above path to correct tclsh binary path! | |
| 4 # | |
| 0 | 5 ########################################################################## |
| 6 # | |
|
114
593874678e45
Clarify authorship by doing sed "s/ccr\/TNSP/Matti 'ccr' Hamalainen/g".
Matti Hamalainen <ccr@tnsp.org>
parents:
69
diff
changeset
|
7 # RuokaLista fetcher v1.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org> |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
8 # (C) Copyright 2010-2011 Tecnic Software productions (TNSP) |
| 0 | 9 # |
| 1 | 10 # This script is freely distributable under GNU GPL (version 2) license. |
| 11 # | |
| 0 | 12 ########################################################################## |
| 13 | |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
14 # Path and filename of the data file, MUST BE SAME as in "ruoka.tcl" |
| 0 | 15 set datafile "/home/niinuska/bot/data.ruoka" |
| 16 | |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
17 # Use a HTTP proxy? (1 = yes, 0 = no) |
| 0 | 18 set http_proxy 0 |
| 19 | |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
20 # HTTP proxy host address and port (only needed if use_proxy = 1) |
| 0 | 21 set http_proxy_host "cache.inet.fi" |
| 22 set http_proxy_port 800 | |
| 23 | |
| 24 | |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
25 ########################################################################## |
| 0 | 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 | |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
258
diff
changeset
|
58 |
| 0 | 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} { | |
| 63 | 70 lappend tmp $item |
| 71 } | |
| 0 | 72 } |
| 73 add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "] | |
| 74 } | |
| 75 set upage [lindex $umatches 3] | |
| 76 } | |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
258
diff
changeset
|
77 |
| 0 | 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 | |
|
6
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
89 |
| 0 | 90 set nmatches 1 |
| 91 while {$nmatches > 0} { | |
|
6
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
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] |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
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] |
| 0 | 94 set nmatches [llength $umatches] |
|
6
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
95 puts "[lindex $umatches 1]" |
| 0 | 96 if {$nmatches > 3} { |
|
6
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
97 # set umat [regexp -nocase -inline -- "^(.+?)<br>" [lindex $umatches 3]] |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
98 set umat [regexp -all -nocase -inline -- "(.\*\?)<br>" [lindex $umatches 2]] |
| 0 | 99 set tmp "" |
| 100 foreach {ukey udata} $umat { | |
| 101 set item [string trim [convert_ent $udata]] | |
| 102 if {[string length $item] > 0} { | |
| 63 | 103 lappend tmp $item |
| 104 } | |
| 0 | 105 } |
| 106 add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "] | |
| 107 } | |
| 108 set upage [lindex $umatches 3] | |
| 109 } | |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
258
diff
changeset
|
110 |
| 0 | 111 return 0 |
| 112 } | |
| 113 | |
| 114 | |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
115 ########################################################################## |
|
6
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
116 set kello [clock seconds] |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
117 set viikko [expr [clock format $kello -format "%W"] + 1] |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
118 set vuosi [clock format $kello -format "%Y"] |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
119 |
| 0 | 120 # Amica/OAMK tekniikan yksikkö |
| 121 add_amica "http://www.amica.fi/kotkanpoika" "OAMK" | |
| 122 | |
| 123 # Oulun yliopiston Unirestat | |
|
6
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
124 set str "http://www.uniresta.fi/2010/ruokalista_tulostettava.php?viikko=$viikko&vuosi=$vuosi&ravintola" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
125 |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
126 add_uniresta "$str=2" "Aularavintola" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
127 add_uniresta "$str=3" "Discus" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
128 add_uniresta "$str=4" "Julinia" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
129 add_uniresta "$str=5" "Kastari" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
130 add_uniresta "$str=6" "Snellmania" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
131 add_uniresta "$str=7" "Pruxis" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
132 add_uniresta "$str=10" "Vanilla" |
|
026257a62da4
ruoka: Some fixes, does not work with the new Amica lists tho.
Matti Hamalainen <ccr@tnsp.org>
parents:
1
diff
changeset
|
133 add_uniresta "$str=11" "Minttu" |
| 0 | 134 |
| 135 | |
|
69
df3230f8aa46
Translate some comments to english and cosmetic fixes.
Matti Hamalainen <ccr@tnsp.org>
parents:
63
diff
changeset
|
136 ########################################################################## |
| 0 | 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 } |