! dc_url.f90 - 変数 URL の文字列解析
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved

module dc_url

    implicit none

    public:: UrlSplit, IORangeParse, GuessDriver, UrlResolve

    interface UrlMerge
        module procedure UrlMergeSO3
        module procedure UrlMergeFVAI
        module procedure UrlMergeFV
    end interface

    interface operator(.OnTheSameFile.)
        module procedure UrlOnTheSameFile
    end interface

    character, public, parameter:: GT_ATMARK = "@"
    character, public, parameter:: GT_COLON = ":"
    character, public, parameter:: GT_COMMA = ","
    character, public, parameter:: GT_EQUAL = "="
    character, public, parameter:: GT_CIRCUMFLEX = "^"
    character, public, parameter:: GT_PLUS = "+"

contains

    ! ANUrlMerge - 変数 URL の合成
    ! 空文字列の成分はないとみなされる。

        type(VSTRING) function &
    UrlMergeSO3(file, var, attr, iorange) result(result)
        use dc_string
        type(VSTRING), intent(in):: file
        type(VSTRING), intent(in), optional:: var
        type(VSTRING), intent(in), optional:: attr
        type(VSTRING), intent(in), optional:: iorange
        result = file // GT_ATMARK
        if (present(var)) result = result // var
        if (present(attr)) then
            if (attr /= "") result = result // GT_COLON // attr
        endif
        if (present(iorange)) then
            if (extract(iorange, 1, 1) == GT_COMMA) then
                result = result // iorange
            else if (iorange /= "") then
                result = result // GT_COMMA // iorange
            endif
        endif
    end function

        type(VSTRING) &
    function UrlMergeFVAI(file, var, attr, iorange) result(result)
        use dc_string
        character(len = *), intent(in):: file
        character(len = *), intent(in):: var
        character(len = *), intent(in):: attr
        character(len = *), intent(in):: iorange
    continue
        result = UrlMerge(var_str(file), var_str(var), var_str(attr), &
            & var_str(iorange))
    end function

        type(VSTRING) &
    function UrlMergeFV(file, var) result(result)
        use dc_string
        character(len = *), intent(in):: file
        character(len = *), intent(in):: var
    continue
        result = UrlMerge(var_str(file), var=var_str(var))
    end function

    ! UrlSplit - 変数 URL の分解
    ! 見つからない成分には空文字列が代入される。

    subroutine UrlSplit(fullname, file, var, attr, iorange)
        use dc_string
        type(VSTRING), intent(in):: fullname
        type(VSTRING), intent(out), optional::        file, var, attr, iorange
        type(VSTRING):: varpart
        integer:: atmark, colon, comma
        character(len = *), parameter:: VARNAME_SET &
            = "0123456789eEdD+-=^,:_" &
            // "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
            // "abcdefghijklmnopqrstuvwxyz"
    continue
        ! まず URL と変数属性指定を分離する。URL は @ を含みうる
        ! ため、最後の @ 以降に対して変数属性として許されない
        ! 文字（典型的には '/'）が含まれていたら
        ! 当該 @ は URL の一部とみなす。
        atmark = vindex(fullname, GT_ATMARK, .TRUE.)
        if (atmark /= 0) then
            varpart = extract(fullname, atmark + 1)
            if (vverify(varpart, VARNAME_SET) /= 0) then
                atmark = 0
            endif
        endif
        if (atmark == 0) then
            ! 変数属性指定はなかった。
            if (present(file)) file = fullname
            if (present(var)) var = ''
            if (present(attr)) attr = ''
            if (present(iorange)) iorange = ''
            return
        endif
        ! 変数属性指定があった。
        if (present(file)) file = extract(fullname, 1, atmark - 1)
        ! 範囲指定を探索する。
        comma = vindex(varpart, GT_COMMA)
        if (comma /= 0) then
            ! 範囲指定がみつかった。
            if (present(var)) var = extract(varpart, 1, comma - 1)
            if (present(attr)) attr = ''
            if (present(iorange)) iorange = extract(varpart, comma + 1)
            return
        endif
        if (present(iorange)) iorange = ''
        ! 範囲指定がなかったので、属性名の検索をする。
        colon = vindex(varpart, GT_COLON)
        if (colon == 0) then
            if (present(var)) var = varpart
            if (present(attr)) attr = ''
            varpart = ''
            return
        endif
        if (present(var)) var = extract(varpart, 1, colon - 1)
        if (present(attr)) attr = extract(varpart, colon + 1)
        varpart = ''
    end subroutine

    !
    ! --- 入出力範囲指定文字列の解析 ---
    !
    ! 入出力範囲指定群 iorange を解析する。最初の範囲指定が解析され、
    ! 次元名は dimname, (下限, 上限, 間隔) が range(1:3),
    ! 残りは remainder に格納される。エラー時は空文字列が格納される。
    ! 次元名１文字目が '^' となっていた場合は除去され range の全要素が添字指定とみなされる。
    !
    ! たとえば "lon=-4.245:+84.2e0,^lat=1:13:2" を解析すると
    ! 一度目:  
    !   dimname="lon", range=(/"-4.245", "+84.2e0", ""/), remainder="^lat=1:13:2"
    ! 二度目:
    !   dimname="lat", range=(/"^1", "^13", "^2"/), remainder=""
    !
    subroutine IORangeParse(iorange, dimname, range, remainder)
        use dc_string
        implicit none
        type(VSTRING), intent(in):: iorange
        type(VSTRING), intent(out):: dimname
        type(VSTRING), intent(out):: range(3)
        type(VSTRING), intent(out):: remainder
        type(VSTRING):: word
        integer:: comma, equal, colon, i
        logical:: hat_all
    continue
        ! iorange に先行するコンマがもしあれば除外したものを word に入れる
        comma = vindex(iorange, GT_COMMA)
        if (comma == 1) then
            comma = vverify(iorange, GT_COMMA)
            word = extract(iorange, comma)
        else
            word = iorange
        endif
        if (len(word) == 0) goto 900
        ! word からコンマ以下を除去し remainder に入れる
        comma = vindex(word, GT_COMMA)
        if (comma == 0) then
            remainder = ""
        else
            remainder = extract(word, comma + 1)
            word = extract(word, 1, comma - 1)
        endif
        ! 最初の '=' までが次元名
        equal = vindex(word, GT_EQUAL)
        dimname = extract(word, 1, equal - 1)
        word = extract(word, equal + 1)
        ! もし次元名の先頭に '^' があれば全部の数値に '^' を先行させたのと同等
        hat_all = (vindex(dimname, GT_CIRCUMFLEX) == 1)
        if (hat_all) dimname = extract(dimname, 2)
        ! もし = が見当たらないならばエラー
        if (len(dimname) == 0) goto 900
        ! 文字列をコロンで区切る
        do, i = 1, 3
            colon = vindex(word, GT_COLON)
            if (colon > 0) then
                range(i) = extract(word, 1, colon - 1)
                word = extract(word, colon + 1)
            else
                range(i) = word
                if (i > 1) word = ""
            endif
            if (hat_all .and. vindex(dimname, GT_CIRCUMFLEX) /= 1) then
                range(i) = GT_CIRCUMFLEX // range(1)
            endif
        enddo
        return
    ! --- 解析できる文字が残っていない場合 ---    
    900 continue
        dimname = "";  remainder = ""
        range(:) = (/(var_str(""), i = 1, 3)/)
    end subroutine

    !
    ! === 変数URL から内部実装の推定 ===
    !
    ! 変数 URL からファイル URL を切り出して判定する。
    ! URL が .nc で終われば、an (Abstract NetCDF) でアクセス。
    ! URL が .ctl で終われば、gr (GrADS) でアクセス。
    ! それ以外の場合、とりあえず an でアクセス。

    subroutine GuessDriver(url, driver)
        use dc_string
        type(VSTRING), intent(in):: url
        type(VSTRING), intent(out):: driver
        type(VSTRING):: filepart
        integer:: length
        call UrlSplit(url, file=filepart)
        length = len(filepart)
        if (extract(filepart, length - 3) == ".ctl") then
            driver = "gr"
        else
            driver = "an"
        endif
    end subroutine

    !
    ! === 同じファイルに載っているかどうか判定 ===
    !

    logical function UrlOnTheSameFile(url_a, url_b) result(result)
        use dc_string
        type(VSTRING), intent(in):: url_a
        type(VSTRING), intent(in):: url_b
        type(VSTRING):: filepart_a
        type(VSTRING):: filepart_b
        call UrlSplit(url_a, file=filepart_a)
        call UrlSplit(url_b, file=filepart_b)
        result = (filepart_a == filepart_b)
    end function

    !
    ! === 相対リンクを解決 ===
    !

    type(VSTRING) function UrlResolve(relative, base) result(result)
        use dc_string, only: StrHead, extract, vscan, VSTRING, &
            & operator(==), operator(//)
        type(VSTRING), intent(in):: relative
        type(VSTRING), intent(in):: base
        integer, parameter:: FILE = 1, VAR = 2, ATTR = 3, IOR = 4
        type(VSTRING):: rel(FILE:IOR), bas(FILE:IOR)
        character(3), parameter:: PATHDELIM = "/:" // achar(94)
        integer:: idir_r, idir_b
        call UrlSplit(relative, file=rel(FILE), var=rel(VAR), &
            & attr=rel(ATTR), iorange=rel(IOR))
        call UrlSplit(base, file=bas(FILE), var=bas(VAR), &
            & attr=bas(ATTR), iorange=bas(IOR))
        if (rel(FILE) == "") then
            rel(FILE) = bas(FILE)
            if (rel(VAR) == "") rel(VAR) = bas(VAR)
            result = UrlMerge(file=rel(FILE), var=rel(VAR), &
                    & attr=rel(ATTR), iorange=rel(IOR))
            return
        endif
        ! --- 相対パスのファイル名を解決 ---
        if (StrHead(rel(FILE), "file:") &
            & .OR. StrHead(rel(FILE), "http:") &
            & .OR. StrHead(rel(FILE), "ftp:") &
            & .OR. StrHead(rel(FILE), "news:") &
            & .OR. StrHead(rel(FILE), "www") &
            & .OR. StrHead(rel(FILE), "/") &
            & .OR. StrHead(rel(FILE), achar(94)) &
            & .OR. extract(rel(FILE), 2, 1) == ":" &
            ) then
            result = relative
            return
        endif
        idir_b = vscan(bas(FILE), PATHDELIM, back=.TRUE.) 
        if (idir_b == 0) then
            result = relative
            return
        endif
        idir_r = vscan(rel(FILE), PATHDELIM, back=.TRUE.)
        result = extract(base, 1, idir_b) // extract(relative, idir_r + 1)
    end function

end module
