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 />| |&nbsp;| |&#160;| |&raquo;|>>|&quot;|\"|&auml;|ä|&ouml;|ö|&Auml;|Ä|&Ouml;|Ö|&amp;|&|&lt;|<|&gt;|>|ä|ä|ö|ö|Ä|Ä" "|"]
+
+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"
+}