diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index c92cc5ff14..43636c0e30 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -65,7 +65,7 @@ subroutine cmd_publish(settings) end do tmp_file = get_temp_filename() - call git_archive('.', tmp_file, error) + call git_archive('.', tmp_file, 'HEAD', settings%verbose, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Archive error: '//error%message) upload_data = [ & @@ -91,7 +91,6 @@ subroutine cmd_publish(settings) end if if (settings%verbose) then - print *, '' call print_upload_data(upload_data) print *, '' end if @@ -102,7 +101,7 @@ subroutine cmd_publish(settings) print *, 'Dry run successful. Generated tarball: ', tmp_file; return end if - call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) + call downloader%upload_form(official_registry_base_url//'/packages', upload_data, settings%verbose, error) call delete_file(tmp_file) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) end diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index 7c5046df4e..39a3314ccf 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -1,6 +1,6 @@ module fpm_downloader use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only: which + use fpm_filesystem, only: which, run use fpm_versioning, only: version_t use jonquil, only: json_object, json_value, json_error, json_load, cast_to_object use fpm_strings, only: string_t @@ -76,9 +76,14 @@ subroutine get_file(url, tmp_pkg_file, error) end !> Perform an http post request with form data. - subroutine upload_form(endpoint, form_data, error) + subroutine upload_form(endpoint, form_data, verbose, error) + !> Endpoint to upload to. character(len=*), intent(in) :: endpoint + !> Form data to upload. type(string_t), intent(in) :: form_data(:) + !> Print additional information if true. + logical, intent(in) :: verbose + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat, i @@ -91,8 +96,8 @@ subroutine upload_form(endpoint, form_data, error) if (which('curl') /= '') then print *, 'Uploading package ...' - call execute_command_line('curl -X POST -H "Content-Type: multipart/form-data" ' & - & //form_data_str//endpoint, exitstat=stat) + call run('curl -X POST -H "Content-Type: multipart/form-data" '// & + & form_data_str//endpoint, exitstat=stat, echo=verbose) else call fatal_error(error, "'curl' not installed."); return end if @@ -104,8 +109,11 @@ subroutine upload_form(endpoint, form_data, error) !> Unpack a tarball to a destination. subroutine unpack(tmp_pkg_file, destination, error) + !> Path to tarball. character(*), intent(in) :: tmp_pkg_file + !> Destination to unpack to. character(*), intent(in) :: destination + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index ad86ca3f73..c007743a90 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -1,7 +1,8 @@ !> Implementation for interacting with git repositories. module fpm_git use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output + use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output, run + implicit none public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & @@ -308,18 +309,22 @@ subroutine info(self, unit, verbosity) end subroutine info !> Archive a folder using `git archive`. - subroutine git_archive(source, destination, error) + subroutine git_archive(source, destination, ref, verbose, error) !> Directory to archive. character(*), intent(in) :: source !> Destination of the archive. character(*), intent(in) :: destination + !> (Symbolic) Reference to be archived. + character(*), intent(in) :: ref + !> Print additional information if true. + logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat character(len=:), allocatable :: cmd_output, archive_format - call execute_and_read_output('git archive -l', cmd_output, error) + call execute_and_read_output('git archive -l', cmd_output, error, verbose) if (allocated(error)) return if (index(cmd_output, 'tar.gz') /= 0) then @@ -328,11 +333,10 @@ subroutine git_archive(source, destination, error) call fatal_error(error, "Cannot find a suitable archive format for 'git archive'."); return end if - call execute_command_line('git archive HEAD --format='//archive_format//' -o '//destination, exitstat=stat) + call run('git archive '//ref//' --format='//archive_format//' -o '//destination, echo=verbose, exitstat=stat) if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if end - end module fpm_git diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 81c5628e40..177ee85fea 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -684,7 +684,6 @@ subroutine getline(unit, line, iostat, iomsg) integer :: size integer :: stat - allocate(character(len=0) :: line) do read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=size) & @@ -1119,24 +1118,30 @@ subroutine get_home(home, error) end subroutine get_home !> Execute command line and return output as a string. - subroutine execute_and_read_output(cmd, output, error, exitstat) + subroutine execute_and_read_output(cmd, output, error, verbose) !> Command to execute. character(len=*), intent(in) :: cmd !> Command line output. character(len=:), allocatable, intent(out) :: output !> Error to handle. type(error_t), allocatable, intent(out) :: error - !> Can optionally used for error handling. - integer, intent(out), optional :: exitstat + !> Print additional information if true. + logical, intent(in), optional :: verbose + + integer :: exitstat, unit, stat + character(len=:), allocatable :: cmdmsg, tmp_file, output_line + logical :: is_verbose - integer :: cmdstat, unit, stat = 0 - character(len=:), allocatable :: cmdmsg, tmp_file - character(len=:),allocatable :: output_line + if (present(verbose)) then + is_verbose = verbose + else + is_verbose = .false. + end if tmp_file = get_temp_filename() - call execute_command_line(cmd//' > '//tmp_file, exitstat=exitstat, cmdstat=cmdstat) - if (cmdstat /= 0) call fatal_error(error, '*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") + call run(cmd//' > '//tmp_file, exitstat=exitstat, echo=is_verbose) + if (exitstat /= 0) call fatal_error(error, '*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") open(newunit=unit, file=tmp_file, action='read', status='old') output = '' @@ -1145,8 +1150,9 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) if (stat /= 0) exit output = output//output_line//' ' end do - close(unit, status='delete',iostat=stat) - end subroutine execute_and_read_output + if (is_verbose) print *, output + close(unit, status='delete') + end !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces function get_dos_path(path,error)