build/os.path.jam

#  Copyright (C) Vladimir Prus 2002. Permission to copy, use, modify, sell and
#  distribute this software is granted provided this copyright notice appears in
#  all copies. This software is provided "as is" without express or implied
#  warranty, and with no claim as to its suitability for any purpose.

import sequence ;
import regex ;
import errors : error ;

#   All path manipulations are done with 'normilized' representation. A path
#   may be either
#   - '.', or
#   - ['/'] [ ( '..' '/' )*  (token '/')* token ]
#   In plain english, path can be rooted, '..' elements are allowed only
#   at the beginning, and it never ends in slash, except for path containg
#   of slash only.
#

os = $(OS) ;
if $(os) = LINIX {
    os = UNIX ;
}

#
#    Converts the native path into normalized form.
#
rule make ( native )
{
    return [ make-$(os) $(native) ] ;
}

#
#    Builds native representation of the path
#
rule native ( path )
{
    return [ native-$(os) $(path) ] ;
}

#
#    Tests if a path is rooted
#
rule is_rooted ( path )
{
    return [ MATCH "^(/)" : $(path) ] ;
}

#
#    Tests if a path has a parent
#
rule has_parent ( path )
{
    if $(path) != / {
        return 1 ;
    } else {
        return ;
    }
}

#
#    Returns parent directory of the path. If no parent exists, error is issued.
#
rule parent ( path )
{
    if [ has_parent $(path) ] {

        if $(path) = . {
            return .. ;
        } else {

            # Strip everything at the end of path up to and including
            # the last slash
            local result = [ regex.match "((.*)/)?([^/]+)" : $(path) : 2 3 ] ;

            # Did we strip what we shouldn't?
            if $(result[2]) = ".." {
                return $(path)/.. ;
            } else {
                if ! $(result[1]) {
                    if [ is_rooted $(path) ] {
                        result = / ;
                    } else {
                        result = . ;
                    }
                }
                return $(result[1]) ;
            }
        }
    } else {
        error "Path '$(path)' has no parent" ;
    }
}

#
#    Returns path2 such that "[ join path path 2 ] = .".
#    The path may not contain ".." element or be rooted.
#
rule reverse ( path )
{
    if $(path) = . {
        return $(path) ;
    } else {
        local tokens = [ regex.split $(path) "/" ] ;
        local tokens2 ;
        for local i in $(tokens) {
            tokens2 += .. ;
        }
        return [ sequence.join $(tokens2) : "/" ] ;
    }
}

#
#    Contanenates two paths together. The second one cannot be rooted.
#
rule join ( path1 path2 )
{
    if $(path1) = . {
        return $(path2) ;
    } else if $(path1) = / {
        return /$(path2) ;
    } else {

        local parts = [ regex.match "((\.\./)*)(.*)" : $(path2) : 1 3 ] ;

        if $(parts[1]) {

            local up_tokens = [ regex.split $(parts[1]) "/" ] ;
            for local i in $(up_tokens[1--2]) {
                path1 = [ parent $(path1) ] ;
            }
        }

        if $(path1) = . {
            return $(parts[2]) ;
        } else if $(path1) = / {
            return /$(parts[2]) ;
        } else {
            return $(path1)/$(parts[2]) ;
        }
    }
}

#
#    If 'path' is relative, it is rooted at 'root'. Otherwise, it's unchanged.
#
rule root_relative_path ( path root )
{
    if [ is_rooted $(path) ] {
        return $(path) ;
    } else {
        return [ join $(root) $(path) ] ;
    }
}

#
#   Find out the absolute name of path and returns the list of all the parents,
#   starting with the immediate one. Parents are returned as relative names.
#   If 'upper_limit' is specified, directories above it will be pruned.
#
rule all_parents ( path : upper_limit ? : cwd ? )
{
    cwd ?= [ PWD ] ;
    local rpath ;
    if ! [ is_rooted $(path) ] {
        rpath = [ root_relative_path $(path) $(cwd) ] ;
    } else {
        rpath = $(path) ;
    }

    if ! $(upper_limit) {
        upper_limit = / ;
    } else {
        if ! [ is_rooted $(upper_limit) ] {
            upper_limit = [ root_relative_path $(upper_limit) $(PWD) ] ;
        }
    }

    # Leave only directory names below 'upper_limits'
    # Assure pruned_path[2] will have no leading '/'
    local pruned_path = [ regex.match "($(upper_limit))/*(.*)" :  $(rpath) : 1 2 ] ;
    if ! $(pruned_path) {
        error "$(upper_limit) is not prefix of $(path)" ;
    }

    local tokens = [ regex.split $(pruned_path[2]) "/" ] ;

    local result ;
    for local i in $(tokens) {
        path = [ parent $(path) ] ;
        result += $(path) ;
    }
    return $(result) ;
}

#
#   Implementation
#
rule make-NT ( native )
{
    local tokens = [ regex.split $(native) "[/\\]" ] ;
    local result ;
    # Handle paths ending with slashes
    if $(tokens[-1) {
        result = [ sequence.join $(tokens) : "/" ] ;
    } else {
        result = [ sequence.join $(tokens[--2]) : "/" ] ;
    }
    if [ regex.match "(^.:)" : $(native)  ] {
        result = /$(result) ;
    }
    return $(result) ;
}

rule native-NT ( path )
{
    local result = [ MATCH "^/?(.*)" : $(path) ] ;
    result = [ sequence.join [ regex.split $(result) "/" ] : "\\" ] ;
    return $(result) ;
}

rule make-UNIX ( native )
{
    return $(native) ;
}

rule native-UNIX ( path ) 
{
    return $(path) ;
}



rule __test__ ( ) {


    import assert ;

    assert.true is_rooted "/" ;
    assert.true is_rooted "/foo" ;
    assert.true is_rooted "/foo/bar" ;
    assert.result : is_rooted "." ;
    assert.result : is_rooted "foo" ;
    assert.result : is_rooted "foo/bar" ;

    assert.true has_parent "foo" ;
    assert.true has_parent "foo/bar" ;
    assert.true has_parent "." ;
    assert.result : has_parent "/" ;

    assert.result "." : parent "foo" ;
    assert.result "/" : parent "/foo" ;
    assert.result "foo/bar" : parent "foo/bar/giz" ;
    assert.result ".." : parent "." ;
    assert.result ".." : parent "../foo" ;
    assert.result "../../foo" : parent "../../foo/bar" ;


    assert.result "." : reverse "." ;
    assert.result ".." : reverse "foo" ;
    assert.result "../../.." : reverse "foo/bar/giz" ;

    assert.result "/foo" : join "/" "foo" ;
    assert.result "foo/bar" : join "foo" "bar" ;
    assert.result "foo/bar" : join "foo/giz" "../bar" ;
    assert.result "foo/giz" : join "foo/bar/baz" "../../giz" ;
    assert.result ".." : join "." ".." ;
    assert.result ".." : join "foo" "../.." ;
    assert.result "../.." : join "../foo" "../.." ;
    assert.result "/foo" : join "/bar" "../foo" ;

    local CWD = "/home/ghost/build" ;
    assert.result . .. ../.. ../../..  : all_parents "Jamfile" : "" : $(CWD) ;
    assert.result foo . .. ../.. ../../.. : all_parents "foo/Jamfile" : "" : $(CWD) ;
    assert.result ../Work .. ../.. ../../.. : all_parents "../Work/Jamfile" : "" : $(CWD) ;

    local CWD = "/home/ghost" ;
    assert.result . .. : all_parents "Jamfile" : "/home" : $(CWD) ;
    assert.result . : all_parents "Jamfile" : "/home/ghost" : $(CWD) ;

    local os = NT ;

    assert.result "foo/bar/giz" : make "foo/bar/giz" ;
    assert.result "foo/bar/giz" : make "foo\\bar\\giz" ;
    assert.result "/D:/My Documents" : make "D:\\My Documents" ;

    assert.result "foo\\bar\\giz" : native "foo/bar/giz" ;
    assert.result "foo" : native "foo" ;
    assert.result "D:\\My Documents\\Work" : native "/D:/My Documents/Work" ;
    
    local os = UNIX ;
    
    assert.result "foo/bar/giz" : make "foo/bar/giz" ;
    assert.result "/foo/bar" : native "/foo/bar" ;

}