get_command_line_settings Subroutine

public subroutine get_command_line_settings(cmd_settings)

! canon_path is not converting “.”, etc. & ‘ unknown help topic “’//trim(unnamed(i)).’not found in:’,manual]

Arguments

Type IntentOptional Attributes Name
class(fpm_cmd_settings), intent(out), allocatable :: cmd_settings

Source Code

    subroutine get_command_line_settings(cmd_settings)
        class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings

        integer, parameter            :: widest = 256
        character(len=4096)           :: cmdarg
        integer                       :: i
        integer                       :: os
        type(fpm_install_settings), allocatable :: install_settings
        type(fpm_publish_settings), allocatable :: publish_settings
        type(fpm_export_settings) , allocatable :: export_settings
        type(version_t) :: version
        character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, &
            & c_compiler, cxx_compiler, archiver, version_s, token_s

        character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", &
            & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", &
            & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", &
            & cxx_env = "CXX", cxx_default = " "
        type(error_t), allocatable :: error

        call set_help()
        os = get_os_type()
        ! text for --version switch,
        select case (os)
            case (OS_LINUX);   os_type =  "OS Type:     Linux"
            case (OS_MACOS);   os_type =  "OS Type:     macOS"
            case (OS_WINDOWS); os_type =  "OS Type:     Windows"
            case (OS_CYGWIN);  os_type =  "OS Type:     Cygwin"
            case (OS_SOLARIS); os_type =  "OS Type:     Solaris"
            case (OS_FREEBSD); os_type =  "OS Type:     FreeBSD"
            case (OS_OPENBSD); os_type =  "OS Type:     OpenBSD"
            case (OS_UNKNOWN); os_type =  "OS Type:     Unknown"
            case default     ; os_type =  "OS Type:     UNKNOWN"
        end select

        ! Get current release version
        version = fpm_version()
        version_s = version%s()

        version_text = [character(len=80) :: &
         &  'Version:     '//trim(version_s)//', alpha',               &
         &  'Program:     fpm(1)',                                     &
         &  'Description: A Fortran package manager and build system', &
         &  'Home Page:   https://github.com/fortran-lang/fpm',        &
         &  'License:     MIT',                                        &
         &  os_type]
        ! find the subcommand name by looking for first word on command
        ! not starting with dash
        CLI_RESPONSE_FILE=.true.
        cmdarg = get_subcommand()

        common_args = &
          ' --directory:C " "' // &
          ' --verbose F'

        run_args = &
          ' --target " "' // &
          ' --list F' // &
          ' --runner " "' // &
          ' --runner-args " "'

        compiler_args = &
          ' --profile " "' // &
          ' --no-prune F' // &
          ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // &
          ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // &
          ' --cxx-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // &
          ' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // &
          ' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // &
          ' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // &
          ' --cxx-flag:: "'//get_fpm_env(cxxflags_env, flags_default)//'"' // &
          ' --link-flag:: "'//get_fpm_env(ldflags_env, flags_default)//'"'

        ! now set subcommand-specific help text and process commandline
        ! arguments. Then call subcommand routine
        select case(trim(cmdarg))

        case('run')
            call set_args(common_args // compiler_args // run_args //'&
            & --all F &
            & --example F&
            & --',help_run,version_text)

            call check_build_vals()

            if( size(unnamed) > 1 )then
                names=unnamed(2:)
            else
                names=[character(len=len(names)) :: ]
            endif


            if(specified('target') )then
               call split(sget('target'),tnames,delimiters=' ,:')
               names=[character(len=max(len(names),len(tnames))) :: names,tnames]
            endif

            ! convert --all to '*'
            if(lget('all'))then
               names=[character(len=max(len(names),1)) :: names,'*' ]
            endif

            ! convert special string '..' to equivalent (shorter) '*'
            ! to allow for a string that does not require shift-key and quoting
            do i=1,size(names)
               if(names(i)=='..')names(i)='*'
            enddo

            ! If there are additional command-line arguments, remove the additional
            ! double quotes which have been added by M_CLI2
            val_runner_args=sget('runner-args')
            call remove_characters_in_set(val_runner_args,set='"')

            c_compiler = sget('c-compiler')
            cxx_compiler = sget('cxx-compiler')
            archiver = sget('archiver')
            allocate(fpm_run_settings :: cmd_settings)
            val_runner=sget('runner')
            if(specified('runner') .and. val_runner=='')val_runner='echo'

            cmd_settings=fpm_run_settings(&
            & args=remaining,&
            & profile=val_profile,&
            & prune=.not.lget('no-prune'), &
            & compiler=val_compiler, &
            & c_compiler=c_compiler, &
            & cxx_compiler=cxx_compiler, &
            & archiver=archiver, &
            & flag=val_flag, &
            & cflag=val_cflag, &
            & cxxflag=val_cxxflag, &
            & ldflag=val_ldflag, &
            & example=lget('example'), &
            & list=lget('list'),&
            & build_tests=.false.,&
            & name=names,&
            & runner=val_runner,&
            & runner_args=val_runner_args, &
            & verbose=lget('verbose') )

        case('build')
            call set_args(common_args // compiler_args //'&
            & --list F &
            & --show-model F &
            & --dump " " &
            & --tests F &
            & --',help_build,version_text)

            call check_build_vals()

            c_compiler = sget('c-compiler')
            cxx_compiler = sget('cxx-compiler')
            archiver = sget('archiver')

            val_dump = sget('dump')
            if (specified('dump') .and. val_dump=='')val_dump='fpm_model.toml'

            allocate( fpm_build_settings :: cmd_settings )
            cmd_settings=fpm_build_settings(  &
            & profile=val_profile,&
            & dump=val_dump,&
            & prune=.not.lget('no-prune'), &
            & compiler=val_compiler, &
            & c_compiler=c_compiler, &
            & cxx_compiler=cxx_compiler, &
            & archiver=archiver, &
            & flag=val_flag, &
            & cflag=val_cflag, &
            & cxxflag=val_cxxflag, &
            & ldflag=val_ldflag, &
            & list=lget('list'),&
            & show_model=lget('show-model'),&
            & build_tests=lget('tests'),&
            & verbose=lget('verbose') )

        case('new')
            call set_args(common_args // '&
            & --src F &
            & --lib F &
            & --app F &
            & --test F &
            & --example F &
            & --backfill F &
            & --full F &
            & --bare F', &
            & help_new, version_text)
            select case(size(unnamed))
            case(1)
                if(lget('backfill'))then
                   name='.'
                else
                   write(stderr,'(*(7x,g0,/))') &
                   & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]'
                   call fpm_stop(1,'directory name required')
                endif
            case(2)
                name=trim(unnamed(2))
            case default
                write(stderr,'(7x,g0)') &
                & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| [--full|--bare] [--backfill]'
                call fpm_stop(2,'only one directory name allowed')
            end select
            !*! canon_path is not converting ".", etc.
            if(name=='.')then
               call get_current_directory(name, error)
               if (allocated(error)) then
                  write(stderr, '("[Error]", 1x, a)') error%message
                  stop 1
               endif
            endif
            name=canon_path(name)
            if( .not.is_fortran_name(to_fortran_name(basename(name))) )then
                write(stderr,'(g0)') [ character(len=72) :: &
                & '<ERROR> the fpm project name must be made of up to 63 ASCII letters,', &
                & '        numbers, underscores, or hyphens, and start with a letter.']
                call fpm_stop(4,' ')
            endif


            allocate(fpm_new_settings :: cmd_settings)
            if (any( specified([character(len=10) :: 'src','lib','app','test','example','bare'])) &
            & .and.lget('full') )then
                write(stderr,'(*(a))')&
                &'<ERROR> --full and any of [--src|--lib,--app,--test,--example,--bare]', &
                &'        are mutually exclusive.'
                call fpm_stop(5,' ')
            elseif (any( specified([character(len=10) :: 'src','lib','app','test','example','full'])) &
            & .and.lget('bare') )then
                write(stderr,'(*(a))')&
                &'<ERROR> --bare and any of [--src|--lib,--app,--test,--example,--full]', &
                &'        are mutually exclusive.'
                call fpm_stop(3,' ')
            elseif (any( specified([character(len=10) :: 'src','lib','app','test','example']) ) )then
                cmd_settings=fpm_new_settings(&
                 & backfill=lget('backfill'),               &
                 & name=name,                               &
                 & with_executable=lget('app'),             &
                 & with_lib=any([lget('lib'),lget('src')]), &
                 & with_test=lget('test'),                  &
                 & with_example=lget('example'),            &
                 & verbose=lget('verbose') )
            else  ! default if no specific directories are requested
                cmd_settings=fpm_new_settings(&
                 & backfill=lget('backfill') ,           &
                 & name=name,                            &
                 & with_executable=.true.,               &
                 & with_lib=.true.,                      &
                 & with_test=.true.,                     &
                 & with_example=lget('full'),            &
                 & with_full=lget('full'),               &
                 & with_bare=lget('bare'),               &
                 & verbose=lget('verbose') )
            endif

        case('help','manual')
            call set_args(common_args, help_help,version_text)
            if(size(unnamed)<2)then
                if(unnamed(1)=='help')then
                   unnamed=['   ', 'fpm']
                else
                   unnamed=manual
                endif
            elseif(unnamed(2)=='manual')then
                unnamed=manual
            endif
            allocate(character(len=widest) :: help_text(0))
            do i=2,size(unnamed)
                select case(unnamed(i))
                case('       ' )
                case('fpm    ' )
                   help_text=[character(len=widest) :: help_text, help_fpm]
                case('new    ' )
                   help_text=[character(len=widest) :: help_text, help_new]
                case('build  ' )
                   help_text=[character(len=widest) :: help_text, help_build]
                case('install' )
                   help_text=[character(len=widest) :: help_text, help_install]
                case('run    ' )
                   help_text=[character(len=widest) :: help_text, help_run]
                case('test   ' )
                   help_text=[character(len=widest) :: help_text, help_test]
                case('runner' )
                   help_text=[character(len=widest) :: help_text, help_runner]
                case('list   ' )
                   help_text=[character(len=widest) :: help_text, help_list]
                case('update ' )
                   help_text=[character(len=widest) :: help_text, help_update]
                case('help   ' )
                   help_text=[character(len=widest) :: help_text, help_help]
                case('version' )
                   help_text=[character(len=widest) :: help_text, version_text]
                case('clean' )
                   help_text=[character(len=widest) :: help_text, help_clean]
                case('publish')
                   help_text=[character(len=widest) :: help_text, help_publish]
                case default
                   help_text=[character(len=widest) :: help_text, &
                   & '<ERROR> unknown help topic "'//trim(unnamed(i))//'"']
                   !!& '<ERROR> unknown help topic "'//trim(unnamed(i)).'not found in:',manual]
                end select
            enddo
            call printhelp(help_text)

        case('install')
            call set_args(common_args // compiler_args // '&
                & --no-rebuild F --prefix " " &
                & --list F --test F &
                & --libdir "lib" --bindir "bin" --testdir "test" --includedir "include"', &
                help_install, version_text)

            call check_build_vals()

            c_compiler = sget('c-compiler')
            cxx_compiler = sget('cxx-compiler')
            archiver = sget('archiver')
            allocate(install_settings, source=fpm_install_settings(&
                list=lget('list'), &
                build_tests=lget('test'), &
                profile=val_profile,&
                prune=.not.lget('no-prune'), &
                compiler=val_compiler, &
                c_compiler=c_compiler, &
                cxx_compiler=cxx_compiler, &
                archiver=archiver, &
                flag=val_flag, &
                cflag=val_cflag, &
                cxxflag=val_cxxflag, &
                ldflag=val_ldflag, &
                no_rebuild=lget('no-rebuild'), &
                verbose=lget('verbose')))
            call get_char_arg(install_settings%prefix, 'prefix')
            call get_char_arg(install_settings%libdir, 'libdir')
            call get_char_arg(install_settings%testdir, 'testdir')
            call get_char_arg(install_settings%bindir, 'bindir')
            call get_char_arg(install_settings%includedir, 'includedir')
            call move_alloc(install_settings, cmd_settings)

        case('list')
            call set_args(common_args // '&
            & --list F&
            &', help_list, version_text)
            if(lget('list'))then
                help_text = [character(widest) :: help_list_nodash, help_list_dash]
            else
                help_text = help_list_nodash
            endif
            call printhelp(help_text)

        case('test')
            call set_args(common_args // compiler_args // run_args // ' --', &
              help_test,version_text)

            call check_build_vals()

            if( size(unnamed) > 1 )then
                names=unnamed(2:)
            else
                names=[character(len=len(names)) :: ]
            endif

            if(specified('target') )then
               call split(sget('target'),tnames,delimiters=' ,:')
               names=[character(len=max(len(names),len(tnames))) :: names,tnames]
            endif

            ! convert special string '..' to equivalent (shorter) '*'
            ! to allow for a string that does not require shift-key and quoting
            do i=1,size(names)
               if(names(i)=='..')names(i)='*'
            enddo

            ! If there are additional command-line arguments, remove the additional
            ! double quotes which have been added by M_CLI2
            val_runner_args=sget('runner-args')
            call remove_characters_in_set(val_runner_args,set='"')

            c_compiler = sget('c-compiler')
            cxx_compiler = sget('cxx-compiler')
            archiver = sget('archiver')
            allocate(fpm_test_settings :: cmd_settings)
            val_runner=sget('runner')
            if(specified('runner') .and. val_runner=='')val_runner='echo'

            cmd_settings=fpm_test_settings(&
            & args=remaining, &
            & profile=val_profile, &
            & prune=.not.lget('no-prune'), &
            & compiler=val_compiler, &
            & c_compiler=c_compiler, &
            & cxx_compiler=cxx_compiler, &
            & archiver=archiver, &
            & flag=val_flag, &
            & cflag=val_cflag, &
            & cxxflag=val_cxxflag, &
            & ldflag=val_ldflag, &
            & example=.false., &
            & list=lget('list'), &
            & build_tests=.true., &
            & name=names, &
            & runner=val_runner, &
            & runner_args=val_runner_args, &
            & verbose=lget('verbose'))

        case('update')
            call set_args(common_args // ' --fetch-only F --clean F --dump " " ', &
                help_update, version_text)

            if( size(unnamed) > 1 )then
                names=unnamed(2:)
            else
                names=[character(len=len(names)) :: ]
            endif

            val_dump = sget('dump')
            if (specified('dump') .and. val_dump=='')val_dump='fpm_dependencies.toml'

            allocate(fpm_update_settings :: cmd_settings)
            cmd_settings=fpm_update_settings(name=names, dump=val_dump, &
                fetch_only=lget('fetch-only'), verbose=lget('verbose'), &
                clean=lget('clean'))

        case('export')

            call set_args(common_args // compiler_args // '&
                & --manifest "filename"  &
                & --model "filename" &
                & --dependencies "filename" ', &
                help_build, version_text)

            call check_build_vals()

            c_compiler = sget('c-compiler')
            cxx_compiler = sget('cxx-compiler')
            archiver = sget('archiver')
            allocate(export_settings, source=fpm_export_settings(&
                profile=val_profile,&
                prune=.not.lget('no-prune'), &
                compiler=val_compiler, &
                c_compiler=c_compiler, &
                cxx_compiler=cxx_compiler, &
                archiver=archiver, &
                flag=val_flag, &
                cflag=val_cflag, &
                show_model=.true., &
                cxxflag=val_cxxflag, &
                ldflag=val_ldflag, &
                verbose=lget('verbose')))
            call get_char_arg(export_settings%dump_model, 'model')
            call get_char_arg(export_settings%dump_manifest, 'manifest')
            call get_char_arg(export_settings%dump_dependencies, 'dependencies')
            call move_alloc(export_settings, cmd_settings)


        case('clean')
            call set_args(common_args // &
            &   ' --registry-cache'   // &
            &   ' --skip'             // &
            &   ' --all',                &
                help_clean, version_text)

            block
                logical :: skip, clean_all

                skip = lget('skip')
                clean_all = lget('all')

                if (all([skip, clean_all])) then
                    call fpm_stop(6, 'Do not specify both --skip and --all options on the clean subcommand.')
                end if

                allocate(fpm_clean_settings :: cmd_settings)
                cmd_settings = fpm_clean_settings( &
                &   registry_cache=lget('registry-cache'), &
                &   clean_skip=skip, &
                &   clean_all=clean_all)
            end block

        case('publish')
            call set_args(common_args // compiler_args //'&
            & --show-package-version F &
            & --show-upload-data F &
            & --dry-run F &
            & --token " " &
            & --list F &
            & --show-model F &
            & --tests F &
            & --', help_publish, version_text)

            call check_build_vals()

            c_compiler = sget('c-compiler')
            cxx_compiler = sget('cxx-compiler')
            archiver = sget('archiver')
            token_s = sget('token')

            allocate(fpm_publish_settings :: cmd_settings)
            cmd_settings = fpm_publish_settings( &
            & show_package_version = lget('show-package-version'), &
            & show_upload_data = lget('show-upload-data'), &
            & is_dry_run = lget('dry-run'), &
            & profile=val_profile,&
            & prune=.not.lget('no-prune'), &
            & compiler=val_compiler, &
            & c_compiler=c_compiler, &
            & cxx_compiler=cxx_compiler, &
            & archiver=archiver, &
            & flag=val_flag, &
            & cflag=val_cflag, &
            & cxxflag=val_cxxflag, &
            & ldflag=val_ldflag, &
            & list=lget('list'),&
            & show_model=lget('show-model'),&
            & build_tests=lget('tests'),&
            & verbose=lget('verbose'),&
            & token=token_s)

        case default

            if(cmdarg.ne.''.and.which('fpm-'//cmdarg).ne.'')then
                call run('fpm-'//trim(cmdarg)//' '// get_command_arguments_quoted(),.false.)
                stop
            else
                call set_args('&
                & --list F&
                &', help_fpm, version_text)
                ! Note: will not get here if --version or --usage or --help
                ! is present on commandline
                if(lget('list'))then
                    help_text = help_list_dash
                elseif(len_trim(cmdarg)==0)then
                    write(stdout,'(*(a))')'Fortran Package Manager:'
                    write(stdout,'(*(a))')' '
                    help_text = [character(widest) :: help_list_nodash, help_usage]
                else
                    write(stderr,'(*(a))')'<ERROR> unknown subcommand [', &
                     & trim(cmdarg), ']'
                    help_text = [character(widest) :: help_list_dash, help_usage]
                endif
                call printhelp(help_text)
            endif

        end select

        if (allocated(cmd_settings)) then
            working_dir = sget("directory")
            call move_alloc(working_dir, cmd_settings%working_dir)
        end if

    contains

    subroutine check_build_vals()
        val_compiler=sget('compiler')
        if(val_compiler=='') val_compiler='gfortran'

        val_flag = " " // sget('flag')
        val_cflag = " " // sget('c-flag')
        val_cxxflag = " "// sget('cxx-flag')
        val_ldflag = " " // sget('link-flag')
        val_profile = sget('profile')

    end subroutine check_build_vals

    !> Print help text and stop
    subroutine printhelp(lines)
    character(len=:),intent(in),allocatable :: lines(:)
    integer :: iii,ii
        if(allocated(lines))then
           ii=size(lines)
           if(ii > 0 .and. len(lines)> 0) then
               write(stdout,'(g0)')(trim(lines(iii)), iii=1, ii)
           else
               write(stdout,'(a)')'<WARNING> *printhelp* output requested is empty'
           endif
        endif
        stop
    end subroutine printhelp

    end subroutine get_command_line_settings