From 83d0c4ab6cf2e8487f8a89d72f9daf528accd49d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Jun 2023 14:45:18 +0700 Subject: [PATCH 1/6] Add verbose output to git_archive --- src/fpm/cmd/publish.f90 | 3 +-- src/fpm/git.f90 | 28 ++++++++++++++++++++++++---- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index c92cc5ff14..121316e7b4 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 diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index ad86ca3f73..f8238b2075 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -308,31 +308,51 @@ 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 + !> Whether to print verbose output. + logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat - character(len=:), allocatable :: cmd_output, archive_format + character(len=:), allocatable :: cmd_output, archive_format, cmd + + if (verbose) then + print *, '' + print *, 'Show git archive options:' + print *, ' + git archive -l' + end if call execute_and_read_output('git archive -l', cmd_output, error) if (allocated(error)) return + if (verbose) print *, ' ', cmd_output + if (index(cmd_output, 'tar.gz') /= 0) then archive_format = 'tar.gz' else 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) + cmd = 'git archive '//ref//' --format='//archive_format//' -o '//destination + + if (verbose) then + print *, '' + print *, 'Archive ', ref, ' using ', archive_format, ':' + print *, ' + ', cmd + print *, '' + end if + + call execute_command_line(cmd, exitstat=stat) if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if end - end module fpm_git From c983e484ff059b6076d20c04709f93c276ff5de6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Jun 2023 15:14:47 +0700 Subject: [PATCH 2/6] Add verbose printout to package upload --- src/fpm/cmd/publish.f90 | 2 +- src/fpm/downloader.f90 | 18 ++++++++++++++---- src/fpm/git.f90 | 2 +- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 121316e7b4..43636c0e30 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -101,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..b557d3ded6 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -76,23 +76,30 @@ 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 when true. + logical, intent(in) :: verbose + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat, i - character(len=:), allocatable :: form_data_str + character(len=:), allocatable :: form_data_str, cmd form_data_str = '' do i = 1, size(form_data) form_data_str = form_data_str//"-F '"//form_data(i)%s//"' " end do + cmd = 'curl -X POST -H "Content-Type: multipart/form-data" '//form_data_str//endpoint + 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) + if (verbose) print *, ' + ', cmd + call execute_command_line(cmd, exitstat=stat) else call fatal_error(error, "'curl' not installed."); return end if @@ -104,8 +111,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 f8238b2075..b053427583 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -315,7 +315,7 @@ subroutine git_archive(source, destination, ref, verbose, error) character(*), intent(in) :: destination !> (Symbolic) Reference to be archived. character(*), intent(in) :: ref - !> Whether to print verbose output. + !> Print additional information when true. logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error From f3d2c1366d8604738711085cc28d5469ec771bf5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Jun 2023 22:30:00 +0700 Subject: [PATCH 3/6] Use run --- src/fpm/downloader.f90 | 12 +++++------- src/fpm/git.f90 | 26 +++++--------------------- src/fpm_filesystem.F90 | 20 ++++++++++++++------ 3 files changed, 24 insertions(+), 34 deletions(-) diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index b557d3ded6..c481324fd4 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 @@ -81,25 +81,23 @@ subroutine upload_form(endpoint, form_data, verbose, error) character(len=*), intent(in) :: endpoint !> Form data to upload. type(string_t), intent(in) :: form_data(:) - !> Print additional information when true. + !> Print additional information if true. logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat, i - character(len=:), allocatable :: form_data_str, cmd + character(len=:), allocatable :: form_data_str form_data_str = '' do i = 1, size(form_data) form_data_str = form_data_str//"-F '"//form_data(i)%s//"' " end do - cmd = 'curl -X POST -H "Content-Type: multipart/form-data" '//form_data_str//endpoint - if (which('curl') /= '') then print *, 'Uploading package ...' - if (verbose) print *, ' + ', cmd - call execute_command_line(cmd, exitstat=stat) + call run('curl -X POST -H "Content-Type: multipart/form-data" '// & + & form_data_str//endpoint, exitstat=stat, verbose=verbose) else call fatal_error(error, "'curl' not installed."); return end if diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index b053427583..602c3c0439 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, & @@ -321,35 +322,18 @@ subroutine git_archive(source, destination, ref, verbose, error) type(error_t), allocatable, intent(out) :: error integer :: stat - character(len=:), allocatable :: cmd_output, archive_format, cmd - - if (verbose) then - print *, '' - print *, 'Show git archive options:' - print *, ' + git archive -l' - end if + 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 (verbose) print *, ' ', cmd_output - if (index(cmd_output, 'tar.gz') /= 0) then archive_format = 'tar.gz' else call fatal_error(error, "Cannot find a suitable archive format for 'git archive'."); return end if - cmd = 'git archive '//ref//' --format='//archive_format//' -o '//destination - - if (verbose) then - print *, '' - print *, 'Archive ', ref, ' using ', archive_format, ':' - print *, ' + ', cmd - print *, '' - end if - - call execute_command_line(cmd, 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 diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index d5637357d1..7e77000a2f 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -1083,24 +1083,31 @@ 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 :: cmdstat, unit, stat = 0 + integer :: exitstat, unit, stat = 0 character(len=:), allocatable :: cmdmsg, tmp_file character(len=1000) :: output_line + logical :: is_verbose + + 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 = '' @@ -1109,6 +1116,7 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) if (stat /= 0) exit output = output//trim(output_line)//' ' end do + if (is_verbose) print *, output close(unit, status='delete') end From 21a71de61c6d4ceb2c4f16749839662a63889cdf Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Jun 2023 22:55:14 +0700 Subject: [PATCH 4/6] Do not initialize stat --- src/fpm_filesystem.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 45d748831d..b493b2e886 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -1152,7 +1152,7 @@ subroutine execute_and_read_output(cmd, output, error, verbose) !> Print additional information if true. logical, intent(in), optional :: verbose - integer :: exitstat, unit, stat = 0 + integer :: exitstat, unit, stat character(len=:), allocatable :: cmdmsg, tmp_file, output_line logical :: is_verbose @@ -1175,7 +1175,7 @@ subroutine execute_and_read_output(cmd, output, error, verbose) output = output//output_line//' ' end do if (is_verbose) print *, output - close(unit, status='delete', iostat=stat) + close(unit, status='delete') end !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces From 1b38b982c2a586eedc96b05f3e1cbe0e5ddbeae1 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Jun 2023 09:45:57 +0700 Subject: [PATCH 5/6] Change verbose to echo --- src/fpm/downloader.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index c481324fd4..39a3314ccf 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -97,7 +97,7 @@ subroutine upload_form(endpoint, form_data, verbose, error) if (which('curl') /= '') then print *, 'Uploading package ...' call run('curl -X POST -H "Content-Type: multipart/form-data" '// & - & form_data_str//endpoint, exitstat=stat, verbose=verbose) + & form_data_str//endpoint, exitstat=stat, echo=verbose) else call fatal_error(error, "'curl' not installed."); return end if From 953c57665d599d129564460ce354d29bfbe4b390 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Jun 2023 10:01:07 +0700 Subject: [PATCH 6/6] Nit --- src/fpm/git.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 602c3c0439..c007743a90 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -316,7 +316,7 @@ subroutine git_archive(source, destination, ref, verbose, error) character(*), intent(in) :: destination !> (Symbolic) Reference to be archived. character(*), intent(in) :: ref - !> Print additional information when true. + !> Print additional information if true. logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error