Merge pull request #938 from fortran-lang/add-verbose-outputs

Add verbose printouts options to `git_archive` and `upload_form`

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

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

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

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)