diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 09fc465272..dc83880f14 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -8,8 +8,8 @@ module fpm_cmd_publish use fpm_model, only: fpm_model_t use fpm_error, only: error_t, fpm_stop use fpm_versioning, only: version_t - use fpm_filesystem, only: exists, join_path, get_tmp_directory - use fpm_git, only: git_archive, compressed_package_name + use fpm_filesystem, only: exists, join_path, get_temp_filename + use fpm_git, only: git_archive use fpm_downloader, only: downloader_t use fpm_strings, only: string_t use fpm_settings, only: official_registry_base_url @@ -31,7 +31,7 @@ subroutine cmd_publish(settings) type(error_t), allocatable :: error type(version_t), allocatable :: version type(string_t), allocatable :: form_data(:) - character(len=:), allocatable :: tmpdir + character(len=:), allocatable :: tmp_file type(downloader_t) :: downloader integer :: i @@ -69,11 +69,10 @@ subroutine cmd_publish(settings) if (allocated(settings%token)) form_data = [form_data, string_t('upload_token="'//settings%token//'"')] - call get_tmp_directory(tmpdir, error) - if (allocated(error)) call fpm_stop(1, '*cmd_publish* Tmp directory error: '//error%message) - call git_archive('.', tmpdir, error) + tmp_file = get_temp_filename() + call git_archive('.', tmp_file, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Pack error: '//error%message) - form_data = [form_data, string_t('tarball=@"'//join_path(tmpdir, compressed_package_name)//'"')] + form_data = [form_data, string_t('tarball=@"'//tmp_file//'"')] if (settings%show_form_data) then do i = 1, size(form_data) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index be4b99bcf6..602516ea74 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -5,10 +5,7 @@ module fpm_git implicit none public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & - & git_archive, git_matches_manifest, operator(==), compressed_package_name - - !> Name of the compressed package that is generated temporarily. - character(len=*), parameter :: compressed_package_name = 'compressed_package' + & git_archive, git_matches_manifest, operator(==) !> Possible git target type :: enum_descriptor @@ -326,8 +323,7 @@ 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 '// & - & join_path(destination, compressed_package_name), exitstat=stat) + call execute_command_line('git archive HEAD --format='//archive_format//' -o '// destination, 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 c7b12a8b5e..4cfe571b6f 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -14,8 +14,7 @@ module fpm_filesystem public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, list_files, get_local_prefix, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, fileopen, fileclose, & filewrite, warnwrite, parent_dir, is_hidden_file, read_lines, read_lines_expanded, which, run, & - LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home, get_tmp_directory, & - execute_and_read_output + LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output integer, parameter :: LINE_BUFFER_LEN = 1000 #ifndef FPM_BOOTSTRAP @@ -1033,21 +1032,15 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) integer, intent(out), optional :: exitstat integer :: cmdstat, unit, stat = 0 - character(len=:), allocatable :: cmdmsg, tmp_path + character(len=:), allocatable :: cmdmsg, tmp_file character(len=1000) :: output_line - call get_tmp_directory(tmp_path, error) - if (allocated(error)) return + tmp_file = get_temp_filename() - if (.not. exists(tmp_path)) call mkdir(tmp_path) - tmp_path = join_path(tmp_path, 'command_line_output') - call delete_file(tmp_path) - call filewrite(tmp_path, ['']) + 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 execute_command_line(cmd//' > '//tmp_path, exitstat=exitstat, cmdstat=cmdstat) - if (cmdstat /= 0) call fpm_stop(1,'*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") - - open(unit, file=tmp_path, action='read', status='old') + open(newunit=unit, file=tmp_file, action='read', status='old') output = '' do read(unit, *, iostat=stat) output_line @@ -1056,30 +1049,4 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) end do close(unit, status='delete') end - - !> Get system-dependent tmp directory. - subroutine get_tmp_directory(tmp_dir, error) - !> System-dependant tmp directory. - character(len=:), allocatable, intent(out) :: tmp_dir - !> Error to handle. - type(error_t), allocatable, intent(out) :: error - - tmp_dir = get_env('TMPDIR', '') - if (tmp_dir /= '') then - tmp_dir = tmp_dir//'fpm'; return - end if - - tmp_dir = get_env('TMP', '') - if (tmp_dir /= '') then - tmp_dir = tmp_dir//'fpm'; return - end if - - tmp_dir = get_env('TEMP', '') - if (tmp_dir /= '') then - tmp_dir = tmp_dir//'fpm'; return - end if - - call fatal_error(error, "Couldn't determine system temporary directory.") - end - end module fpm_filesystem