gaucheでgoogleの非公開apiを使って天気を取得するコマンド

某所で掲題のようなgaucheのコードを見かけたのでコマンドにしてみた。

$ ./weather kumamoto
kumamoto:2011-11-12
condition:Cloudy
temp_f:60
temp_c:15
humidity:Humidity: 77%
icon:/ig/images/weather/cloudy.gif
wind_condition:Wind: E at 0 mph

day_of_week:Sat
low:52
high:73
icon:/ig/images/weather/mostly_sunny.gif
condition:Partly Sunny

day_of_week:Sun
low:46
high:70
icon:/ig/images/weather/mostly_sunny.gif
condition:Mostly Sunny

day_of_week:Mon
low:37
high:63
icon:/ig/images/weather/sunny.gif
condition:Clear

day_of_week:Tue
low:41
high:64
icon:/ig/images/weather/sunny.gif
condition:Clear

$ ./weather -j kumamoto
{"date":"2011-11-12","current":{"condition":"Cloudy","temp_f":"60","temp_c":"15","humidity":"Humidity: 77%","icon":"/ig/images/weather/cloudy.gif","wind_condition":"Wind: E at 0 mph"},"in_the_future":[{"day_of_week":"Sat","low":"52","high":"73","icon":"/ig/images/weather/mostly_sunny.gif","condition":"Partly Sunny"},{"day_of_week":"Sun","low":"46","high":"70","icon":"/ig/images/weather/mostly_sunny.gif","condition":"Mostly Sunny"},{"day_of_week":"Mon","low":"37","high":"63","icon":"/ig/images/weather/sunny.gif","condition":"Clear"},{"day_of_week":"Tue","low":"41","high":"64","icon":"/ig/images/weather/sunny.gif","condition":"Clear"}]}#% 

ソースはこちら。

	#!/usr/local/bin/gosh
	(use srfi-1)
	(use sxml.ssax)
	(use sxml.sxpath)
	(use rfc.http)
	(use rfc.json)
	(use gauche.parseopt)
	(define (usage)
	(print "Usage: weather [options ...] city-name")
	(print " - c|city : city name")
	(print " - j|json : print json format")
	(print " - h|help : print usage")
	(exit 2))
	(define (get-weather-xml city)
	(receive (status head body)
	(http-get "www.google.com" (string-append "/ig/api?weather=" city))
	(ssax:xml->sxml (open-input-string body) '())))
	(define (print-weather weather)
	(for-each (^e (display (car e))
	(display ":")
	(print (cadr (cadadr e))))
	(cdr weather))
	(newline))
	(define (weather->alist weather)
	(map (^e (cons (x->string (car e))
	(x->string (cadar (cdadr e)))))
	(cdr weather)))
	(define (weathers->json date weathers)
	(construct-json
	(list (cons "date" date)
	(cons "current" (weather->alist (car weathers)))
	(cons "in_the_future" (list->vector (map weather->alist (cdr weathers)))))))
	(define (main args)
	(let-args (cdr args)
	((city "c|city=s")
	(json "j|json")
	(help "h|help" => usage)
	. rest)
	(let* ((city (or city (if (null? rest)
	(symbol->string (read))
	(car rest))))
	(xml (get-weather-xml city))
	(weathers (drop (car ((sxpath "/xml_api_reply/weather") xml)) 3))
	(date (car ((sxpath "/xml_api_reply/weather/forecast_information/forecast_date/@data[1]/text()") xml))))
	(if json
	(write (weathers->json date weathers))
	(begin (print city ":" date)
	(print-weather (car weathers))
	(for-each print-weather (cdr weathers)))))))

view raw weather.scm hosted with ❤ by GitHub

関連

• vallog: gaucheのtext.progressとtputコマンド（コマンド？）
• vallog: 最近の雑多なコマンド（gauche）
• vallog: gaucheで「プログラマに半角全角の入り乱れた英数字を見せ続けると死ぬ。」コマンド