Paste: get yahoo taiwan exchange info

Author: cataska
Mode: factor
Date: Thu, 26 Mar 2009 03:15:14
Plain Text |
USING: formatting http.client sequences strings kernel io math regexp
unicode.case assocs ;

IN: currency

: coins ( -- array )
    {
        "TWD" "CNY" "JPY" "KRW"
        "HKD" "THB" "SGD" "IDR"
        "VND" "MYR" "PHP" "INR"
        "AED" "KWD" "AUD" "NZD"
        "USD" "CAD" "BRL" "MXN"
        "ARS" "CLP" "VEB" "EUR"
        "GBP" "RUB" "CHF" "SEK"
        "ZAR"
    } ;

: coins? ( coin -- ? )
    coins member? ;

: calias ( -- hashtable )
    H{
        { "NTD" "TWD" }
        { "RMB" "CNY" }
    } ;

: calias? ( alias -- ? )
    calias keys member? ;

: calias-at ( alias -- value/? )
    dup calias? [ calias at ] [ drop f ] if ;

: yahootw-url ( -- url )
    "http://tw.money.yahoo.com/currency_exc_result?amt=%d&from=%s&to=%s" ;

: div-tag ( -- text )
    "            <div class" ;

: make-url ( money from to -- url )
    yahootw-url sprintf ;

: strip-em-tag ( str -- newstr )
    R! </?em>! "" re-replace ;

: find-exchange ( str -- result )
    "經過計算後," over start 7 + cut div-tag over start 0 spin subseq strip-em-tag nip ;

: get-ex-money ( money from to -- result )
    [ >upper ] bi@ 2dup [
      ! dup coins? [ t ] [ dup calias? [ calias-at t ] [ f ] if ] if
      coins?
      ! coins? [ t ] 
    ] bi@
    and [ make-url http-get nip find-exchange ]
    [ 3drop f ] if ;

New Annotation

Summary:
Author:
Mode:
Body: