new_installer Subroutine

public subroutine new_installer(self, prefix, bindir, libdir, includedir, verbosity, copy, move)

Create a new instance of an installer

Arguments

Type IntentOptional Attributes Name
type(installer_t), intent(out) :: self

Instance of the installer

character(len=*), intent(in), optional :: prefix

Path to installation directory

character(len=*), intent(in), optional :: bindir

Binary dir relative to the installation prefix

character(len=*), intent(in), optional :: libdir

Library directory relative to the installation prefix

character(len=*), intent(in), optional :: includedir

Include directory relative to the installation prefix

integer, intent(in), optional :: verbosity

Verbosity of the installer

character(len=*), intent(in), optional :: copy

Copy command

character(len=*), intent(in), optional :: move

Move command


Source Code

  subroutine new_installer(self, prefix, bindir, libdir, includedir, verbosity, &
          copy, move)
    !> Instance of the installer
    type(installer_t), intent(out) :: self
    !> Path to installation directory
    character(len=*), intent(in), optional :: prefix
    !> Binary dir relative to the installation prefix
    character(len=*), intent(in), optional :: bindir
    !> Library directory relative to the installation prefix
    character(len=*), intent(in), optional :: libdir
    !> Include directory relative to the installation prefix
    character(len=*), intent(in), optional :: includedir
    !> Verbosity of the installer
    integer, intent(in), optional :: verbosity
    !> Copy command
    character(len=*), intent(in), optional :: copy
    !> Move command
    character(len=*), intent(in), optional :: move

    self%os = get_os_type()

    ! By default, never prompt the user for overwrites
    if (present(copy)) then
      self%copy = copy
    else
      if (os_is_unix(self%os)) then
        self%copy = default_force_copy_unix
      else
        self%copy = default_force_copy_win
      end if
    end if

    if (present(move)) then
      self%move = move
    else
      if (os_is_unix(self%os)) then
        self%move = default_move_unix
      else
        self%move = default_move_win
      end if
    end if

    if (present(includedir)) then
      self%includedir = includedir
    else
      self%includedir = default_includedir
    end if

    if (present(prefix)) then
      self%prefix = prefix
    else
      self%prefix = get_local_prefix(self%os)
    end if

    if (present(bindir)) then
      self%bindir = bindir
    else
      self%bindir = default_bindir
    end if

    if (present(libdir)) then
      self%libdir = libdir
    else
      self%libdir = default_libdir
    end if

    if (present(verbosity)) then
      self%verbosity = verbosity
    else
      self%verbosity = 1
    end if

  end subroutine new_installer