# Copyright 2003 Dave Abrahams 
# Copyright 2005, 2006 Rene Rivera 
# Copyright 2002, 2003, 2004, 2005, 2006 Vladimir Prus 
# Distributed under the Boost Software License, Version 1.0. 
# (See accompanying file LICENSE_1_0.txt or http://www.boost.org/LICENSE_1_0.txt) 

#  This module defines the 'install' rule, used to copy a set of targets to
#  a single location

import targets ;
import "class" : new ;
import property ;
import errors : error ;
import type : type ;
import type ;
import regex ;
import generators ;
import feature ;
import project ;
import property-set ;
import virtual-target ;
import path ;

feature.feature <install-dependencies> : off on : incidental ;
feature.feature <install-type> : : free incidental ;
feature.feature <install-source-root> : : free path  ;
# If 'on', version symblinks for shared libraries won't be created
# This feature has effect only on Unix.
feature.feature <install-no-version-symlinks> : on : optional incidental ;
feature.feature <so-version> : : free incidental ;

class install-target-class : basic-target
{
    import feature project type errors generators path stage ;    
    import "class" : new ;
    
    rule __init__ ( name-and-dir : project : sources * : requirements * : default-build * )
    {
        basic-target.__init__ $(name-and-dir) : $(project) : $(sources) : $(requirements) 
          : $(default-build) ;
    }

    # If <location> is not set, sets it based on the project data.
    rule update-location ( property-set )
    {
        local loc = [ $(property-set).get <location> ] ;
        if ! $(loc)
        {
            loc = [ path.root $(self.name) [ $(self.project).get location ] ] ;

            property-set = [ $(property-set).add-raw $(loc:G=<location>) ] ;
        }
        
        return $(property-set) ;
    }
            
    # Takes a target that is installed and property set which is
    # used when installing.
    rule adjust-properties ( target : build-property-set )
    {
        local ps-raw ;
        local a = [ $(target).action ] ;       
        if $(a)
        {
            local ps = [ $(a).properties ] ;
            ps-raw = [ $(ps).raw ] ;
                        
            # Unless <hardcode-dll-paths>true is in properties, which can
            # happen only if the user has explicitly requested it, nuke all
            # <dll-path> properties                                  
            if [ $(property-set).get <hardcode-dll-paths> ] != true
            {
                ps-raw = [ property.change $(ps-raw) : <dll-path> ] ;
            }
            
            # If any <dll-path> properties were specified for installing,
            # add them.
            local l = [ $(build-property-set).get <dll-path> ] ;
            ps-raw += $(l:G=<dll-path>) ;
            
            # Also copy <linkflags> feature from current build
            # set, to be used for relinking.
            local l = [ $(build-property-set).get <linkflags> ] ;
            ps-raw += $(l:G=<linkflags>) ;            
        }
        
        # Remove the <tag> feature on original targets.
        ps-raw = [ property.change $(ps-raw) : <tag> ] ;
        # And <location>. If stage target has another stage target
        # in sources, then we'll get virtual targets with <location>
        # property set.
        ps-raw = [ property.change $(ps-raw) : <location> ] ;
        
        
        local d = [ $(build-property-set).get <dependency> ] ;
        ps-raw += $(d:G=<dependency>) ;
        
        local d = [ $(build-property-set).get <location> ] ;
        ps-raw += $(d:G=<location>) ;
        
        local ns = [ $(build-property-set).get <install-no-version-symlinks> ] ;
        ps-raw += $(ns:G=<install-no-version-symlinks>) ;
        
        local d = [ $(build-property-set).get <install-source-root> ] ;
        # Make the path absolute: we'll use it to compute relative
        # paths and making the path absolute will help.
        if $(d)
        {            
            d = [ path.root $(d) [ path.pwd ] ] ;
            ps-raw += $(d:G=<install-source-root>) ;
        }        
        
        if $(ps-raw)
        {
            return [ property-set.create $(ps-raw) ]  ;
        }        
        else
        {
            return [ property-set.empty ] ;
        }        
    }
    
        
    rule construct ( name : source-targets * : property-set )
    {                
        source-targets = [ 
          targets-to-stage $(source-targets) : $(property-set) ] ;
        
        property-set = [ update-location $(property-set) ] ;          
        
        local ename = [ $(property-set).get <name> ] ;              
                
        if $(ename) && $(source-targets[2])
        {
            errors.error 
              "When <name> property is used in 'install', only one source is allowed" ;
        }
        
                                       
        local result ;
        for local i in $(source-targets)
        {            
            local staged-targets ;
                        
            local new-properties = 
              [ adjust-properties $(i) : $(property-set) ] ;
                                    
            # See if something special should be done when staging this
            # type. It is indicated by presense of special "staged" type            
            local t = [ $(i).type ] ;            
            if $(t) && [ type.registered INSTALLED_$(t) ]
            {
                if $(ename)
                {
                    error.error "In 'install': <name> property specified with target that requires relinking" ;
                }
                else
                {
                    local targets = [ generators.construct $(self.project) $(name) : 
                      INSTALLED_$(t) : $(new-properties) : $(i) ] ;
                    staged-targets += $(targets[2-]) ;                                
                }                                                
            }
            else             
            {                
                staged-targets = [ stage.copy-file $(self.project) $(ename)
                  : $(i) : $(new-properties) ] ;
            }
            
            if ! $(staged-targets)
            {                    
                errors.error "Unable to generate staged version of " [ $(source).str ] ;
            }                
            
            for t in $(staged-targets) 
            {
                result += [ virtual-target.register $(t) ] ;          
            }            
        }
        
        return [ property-set.empty ] $(result) ;
    }   
    

    # Given the list of source targets explicitly passed to 'stage',
    # returns the list of targets which must be staged.
    rule targets-to-stage ( source-targets * : property-set )
    {   
        local result ;
               
        # Traverse the dependencies, if needed.
        if [ $(property-set).get <install-dependencies> ] = "on"
        {
            source-targets = [ collect-targets $(source-targets) ] ;
        }
        
        # Filter the target types, if needed
        local included-types = [ $(property-set).get <install-type> ] ;                               
        for local r in $(source-targets)
        {
            local ty = [ $(r).type ] ;        
            if $(ty)
            {
                # Don't stage searched libs.
                if $(ty) != SEARCHED_LIB
                {
                    if $(included-types)
                    {                        
                        if [ include-type $(ty) : $(included-types) ]
                        {
                            result += $(r) ;
                        }                                    
                    }                
                    else
                    {
                        result += $(r) ;                        
                    }   
                }                                
            }
            else if ! $(included-types)
            {
                # Don't install typeless target if there's
                # explicit list of allowed types.
                result += $(r) ;
            }                
        }
                
        return $(result) ;
    }
    
    # CONSIDER: figure out why we can't use virtual-target.traverse here.
    rule collect-targets ( targets * )
    {
        # Find subvariants
        local s ;        
        for local t in $(targets)
        {
            s += [ $(t).creating-subvariant ] ;
        }
        s = [ sequence.unique $(s) ] ;
        
        local result = $(targets) ;
        for local i in $(s)
        {
            result += [ $(i).all-referenced-targets ] ;
        }
        local result2 ;
        for local r in $(result)
        {
            if $(r:G) != <use>
            {
                result2 += $(r:G=) ;
            }            
        }        
        result = [ sequence.unique $(result2) ] ;        
    }
                
    # Returns true iff 'type' is subtype of some element of 'types-to-include'.
    local rule include-type ( type : types-to-include * )
    {
        local found ;
        while $(types-to-include) && ! $(found)
        {
            if [ type.is-subtype $(type) $(types-to-include[1]) ]
            {
                found = true ;
            }            
            types-to-include = $(types-to-include[2-]) ;
        }
        
        return $(found) ;
    }            
}

# Creates a copy of target 'source'. The 'properties' object should
# have a <location> property which specifies where the target must
# be placed.
rule copy-file ( project name ? : source : properties )
{   
    local targets ;
    name ?= [ $(source).name ] ;

    new-a = [ 
      new non-scanning-action $(source) : common.copy : $(properties) ] ;    
    local source-root = [ $(properties).get <install-source-root> ] ;
    if $(source-root) 
    {        
        # Get the real path of the target. We probably need to strip
        # relative path from the target name at construction...
        local path = [ $(source).path ] ;
        path = [ path.root $(name:D) $(path) ] ;
        # Make the path absolute. Otherwise, it's hard to compute relative
        # path. The 'source-root' is already absolute, see the
        # 'adjust-properties' method above.
        path = [ path.root $(path) [ path.pwd ] ] ;
        
        relative = [ path.relative-to $(source-root) $(path) ] ;        
        # Note: using $(name:D=$(relative)) might be faster
        # here, but then we need to explicitly check that
        # relative is not ".", otherwise we might get paths like
        #
        #   <prefix>/boost/.
        #
        # try to create it, and mkdir will obviously fail.
        name = [ path.root $(name:D=) $(relative) ] ;                      
        targets = [ new file-target $(name) exact : [ $(source).type ] 
          : $(project) : $(new-a) ] ;
                
    }        
    else
    {
        targets = [ new file-target $(name:D=) exact : [ $(source).type ] 
          : $(project) : $(new-a) ] ;
    }
            
    return $(targets) ;
}

rule symlink ( name : project : source : properties )
{
    local a = [ new action $(source) : symlink.ln :
      $(properties) ] ;
    local targets = [ 
     new file-target $(name) exact : [ $(source).type ] : $(project) : $(a) ] ;
    
    return $(targets) ;
}

rule relink-file ( project : source : property-set  ) 
{                                
    local action = [ $(source).action ] ;
    local cloned-action = [ virtual-target.clone-action $(action) : $(project) :
      "" : $(property-set) ] ;
    local result = [ $(cloned-action).targets ] ;                        
    
    return $(result) ;
}

# Declare installed version of the EXE type. Generator for this type will
# cause relinking to the new location.
type.register INSTALLED_EXE : : EXE ;

class installed-exe-generator : generator
{
    import type property-set modules stage ;
    
    rule __init__ ( )
    {
        generator.__init__ install-exe : EXE : INSTALLED_EXE ;
    }
    
    rule run ( project name ? : property-set : source : multiple ? )
    {
        if [ $(property-set).get <os> ] in NT CYGWIN
        {
            # Relinking is never needed on NT
            return [ stage.copy-file $(project) 
              : $(source) : $(property-set) ] ; 
        }
        else 
        {
            return [ stage.relink-file $(project) 
              : $(source) : $(property-set) ] ;            
        }                
    }    
}

generators.register [ new installed-exe-generator ] ;


# Installing shared link on Unix might cause a creation of
# versioned symbolic links. 
type.register INSTALLED_SHARED_LIB : : SHARED_LIB ;
class installed-shared-lib-generator : generator
{
    import type property-set modules stage ;
    
    rule __init__ ( )
    {
        generator.__init__ install-shared-lib : SHARED_LIB
          : INSTALLED_SHARED_LIB ;
    }
    
    rule run ( project name ? : property-set : source : multiple ? )
    {                        
        if [ $(property-set).get <os> ] = NT
        {
            local copied = [ stage.copy-file $(project) 
              : $(source) : $(property-set) ] ; 
        
            copied = [ virtual-target.register $(copied) ] ;
            
            return $(copied) ;
        }
        else 
        {
            local a = [ $(source).action ] ;            
            local copied ;
            if ! $(a)
            {
                # Non-derived file, just copy.
                copied = [ stage.copy-file $(project) 
                  : $(source) : $(property-set) ] ; 
            }
            else
            {                            
                local cp = [ $(a).properties ] ;
                local current-dll-path = [ $(cp).get <dll-path> ] ;
                local new-dll-path = [ $(property-set).get <dll-path> ] ;
                                    
                if $(current-dll-path) != $(new-dll-path)
                {
                    # Rpath changed, need to relink.
                    copied = [ stage.relink-file 
                        $(project) : $(source) : $(property-set) ] ;
                }
                else
                {                                        
                    copied = [ stage.copy-file $(project) 
                      : $(source) : $(property-set) ] ; 
                }
            }
                                
            copied = [ virtual-target.register $(copied) ] ;
                                    
            local result = $(copied) ;
            # If the name is in the form NNN.XXX.YYY.ZZZ, where all
            # 'X', 'Y' and 'Z' are numbers, we need to create
            # NNN.XXX and NNN.XXX.YYY symbolic links.
            local m = [ MATCH (.*)\\.([0123456789]+)\\.([0123456789]+)\\.([0123456789]+)$ 
              : [ $(copied).name ] ] ;
            if $(m)
            {
                # Symlink without version at all is used to make
                # -lsome_library work.
                result += [ stage.symlink $(m[1]) : $(project)
                  : $(copied) : $(property-set) ] ;                
                
                # Symlinks of some libfoo.N and libfoo.N.M are used
                # so that library can found at runtime, if libfoo.N.M.X
                # has soname of libfoo.N. That happens when the library
                # makes some binary compatibility guarantees. If not,
                # it's possible to skip those symlinks.
                local suppress = 
                  [ $(property-set).get <install-no-version-symlinks> ] ;
                
                if $(suppress) != "on"
                {                    
                    result += [ stage.symlink $(m[1]).$(m[2]) : $(project)
                      : $(copied) : $(property-set) ] ;
                    result += [ stage.symlink $(m[1]).$(m[2]).$(m[3])  : $(project)
                      : $(copied) : $(property-set) ] ;
                }                
            }
                                                
            return $(result) ;
        }                
    }    
}

generators.register [ new installed-shared-lib-generator ] ;



# Main target rule for 'install'
rule install ( name : sources * : requirements * : default-build * )
{
    local project = [ project.current ] ;
    
    # Unless the user has explicitly asked us to hardcode dll paths, add
    # <hardcode-dll-paths>false in requirements, to override default
    # value.
    if ! <hardcode-dll-paths>true in $(requirements)
    {
        requirements += <hardcode-dll-paths>false ;
    }        
        
    if <tag> in $(requirements:G)
    {
        errors.user-error 
          "The <tag> property is not allowed for the 'install' rule" ;
    }
           
    targets.main-target-alternative
      [ new install-target-class $(name) : $(project) 
        : [ targets.main-target-sources $(sources) : $(name) ]
        : [ targets.main-target-requirements $(requirements) : $(project) ] 
        : [ targets.main-target-default-build $(default-build) : $(project) ] 
      ] ;
}

IMPORT $(__name__) : install : : install ;
IMPORT $(__name__) : install : : stage ;