Mercurial > hg > egg-tcls
diff hae_ruoka.tcl @ 0:1c4e2814cd41
Initial import.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Tue, 21 Sep 2010 13:12:49 +0300 |
parents | |
children | bdb2b1fd6601 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hae_ruoka.tcl Tue Sep 21 13:12:49 2010 +0300 @@ -0,0 +1,138 @@ +#!/usr/bin/tclsh +########################################################################## +# +# RuokaLista fetcher v1.0 by ccr/TNSP <ccr@tnsp.org> +# (C) Copyright 2010 Tecnic Software productions (TNSP) +# +########################################################################## + +# Datatiedosto, oltava sama kuin ruoka.tcl:n vastaava asetus +set datafile "/home/niinuska/bot/data.ruoka" + +# Käytä HTTP proxya? 1 = kyllä, 0 = ei +set http_proxy 0 + +# HTTP proxyn osoite ja portti +set http_proxy_host "cache.inet.fi" +set http_proxy_port 800 + + +############################################################################## +set html_ent [split "\n| |\r| |<br />| | | | | |»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"] + +package require http +::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5" +if {$http_proxy != 0} { + ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port +} + + +proc convert_ent {udata} { + global html_ent + return [string map $html_ent $udata] +} + + +proc add_entry {uname uday udate udesc} { + global entries + set utest "$uname:$udate" + if {[catch {set utmp $entries($utest)}]} { + set entries($utest) [list $uname $uday $udate $udesc] + } +} + + +proc add_amica {datauri dataname} { + if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" + return 1 + } + + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set nmatches 1 + while {$nmatches > 0} { + set umatches [regexp -nocase -inline -- "<strong>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai)</strong></td>.?.?<td colspan=\"2\"><strong>(\[^<\]+)</strong></td>(.*)\$" $upage] + set nmatches [llength $umatches] + if {$nmatches > 3} { + set umat [regexp -nocase -inline -- "^(.+?)(<td colspan=\"3\">|</tbody>)" [lindex $umatches 3]] + set umat [regexp -all -nocase -inline -- "<td colspan=\"\[78\]\">(.\*\?)</td>" [lindex $umat 1]] + set tmp "" + foreach {ukey udata} $umat { + set item [string trim [convert_ent $udata]] + if {[string length $item] > 0} { + lappend tmp $item + } + } + add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "] + } + set upage [lindex $umatches 3] + } + + return 0 +} + +proc add_uniresta {datauri dataname} { + if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} { + puts "Error getting $datauri: $uerrmsg" + return 1 + } + + set upage [::http::data $utoken] + ::http::cleanup $utoken + + set nmatches 1 + while {$nmatches > 0} { + set umatches [regexp -nocase -inline -- "<span class='otsikko'>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai) +(\[^<\]+)</span>(.*)\$" $upage] + set nmatches [llength $umatches] + if {$nmatches > 3} { + set umat [regexp -nocase -inline -- "^(.+?)<br /><br /><br />" [lindex $umatches 3]] + set umat [regexp -all -nocase -inline -- "(.\*\?)<br>" [lindex $umat 1]] + set tmp "" + foreach {ukey udata} $umat { + set item [string trim [convert_ent $udata]] + if {[string length $item] > 0} { + lappend tmp $item + } + } + add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "] + } + set upage [lindex $umatches 3] + } + + return 0 +} + + +############################################################################## +# Amica/OAMK tekniikan yksikkö +add_amica "http://www.amica.fi/kotkanpoika" "OAMK" + +# Oulun yliopiston Unirestat +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=2" "Aularavintola" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=3" "Discus" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=4" "Julinia" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=5" "Kastari" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=6" "Snellmania" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=7" "Pruxis" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=10" "Vanilla" +add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=11" "Minttu" + + +############################################################################## +### Open result datafile and save data +set tmpfname "$datafile.tmp" +if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} { + puts "Error opening $tmpfname for writing: $uerrmsg" + return 1 +} + +foreach {ukey udata} [array get entries] { + puts $outfile [join $udata "½"] +} + +close $outfile +if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} { + puts "Error renaming $tmpfname to $datafile: $uerrmsg" +}