| 1 | module git_ops_module |
| 2 | use iso_fortran_env, only: error_unit |
| 3 | implicit none |
| 4 | private |
| 5 | |
| 6 | public :: git_commit, git_push, git_fetch, git_pull, git_tag |
| 7 | public :: git_check_upstream, git_diff_file, git_list_tags, git_push_tag |
| 8 | |
| 9 | contains |
| 10 | |
| 11 | subroutine git_commit(workspace_path, message, success) |
| 12 | character(len=*), intent(in) :: workspace_path |
| 13 | character(len=*), intent(in) :: message |
| 14 | logical, intent(out) :: success |
| 15 | character(len=2048) :: command |
| 16 | integer :: status |
| 17 | |
| 18 | success = .false. |
| 19 | |
| 20 | if (len_trim(message) == 0) then |
| 21 | write(error_unit, '(A)') 'Error: Empty commit message' |
| 22 | return |
| 23 | end if |
| 24 | |
| 25 | ! Build git commit command with message |
| 26 | write(command, '(A,A,A,A,A)') 'cd "', trim(workspace_path), '" && git commit -m "', trim(message), '" 2>&1' |
| 27 | call execute_command_line(trim(command), exitstat=status) |
| 28 | |
| 29 | success = (status == 0) |
| 30 | end subroutine git_commit |
| 31 | |
| 32 | subroutine git_push(workspace_path, success) |
| 33 | character(len=*), intent(in) :: workspace_path |
| 34 | logical, intent(out) :: success |
| 35 | character(len=1024) :: command |
| 36 | integer :: status |
| 37 | logical :: has_upstream |
| 38 | |
| 39 | success = .false. |
| 40 | |
| 41 | ! Check if upstream is configured |
| 42 | call git_check_upstream(workspace_path, has_upstream) |
| 43 | |
| 44 | if (.not. has_upstream) then |
| 45 | ! Try to set upstream to origin/current-branch |
| 46 | write(command, '(A,A,A)') 'cd "', trim(workspace_path), & |
| 47 | '" && git push --set-upstream origin $(git rev-parse --abbrev-ref HEAD) 2>&1' |
| 48 | else |
| 49 | ! Normal push |
| 50 | write(command, '(A,A,A)') 'cd "', trim(workspace_path), '" && git push 2>&1' |
| 51 | end if |
| 52 | |
| 53 | call execute_command_line(trim(command), exitstat=status) |
| 54 | success = (status == 0) |
| 55 | end subroutine git_push |
| 56 | |
| 57 | subroutine git_fetch(workspace_path, success) |
| 58 | character(len=*), intent(in) :: workspace_path |
| 59 | logical, intent(out) :: success |
| 60 | character(len=1024) :: command |
| 61 | integer :: status |
| 62 | |
| 63 | success = .false. |
| 64 | |
| 65 | write(command, '(A,A,A)') 'cd "', trim(workspace_path), '" && git fetch 2>&1' |
| 66 | call execute_command_line(trim(command), exitstat=status) |
| 67 | |
| 68 | success = (status == 0) |
| 69 | end subroutine git_fetch |
| 70 | |
| 71 | subroutine git_pull(workspace_path, success) |
| 72 | character(len=*), intent(in) :: workspace_path |
| 73 | logical, intent(out) :: success |
| 74 | character(len=1024) :: command |
| 75 | integer :: status |
| 76 | |
| 77 | success = .false. |
| 78 | |
| 79 | write(command, '(A,A,A)') 'cd "', trim(workspace_path), '" && git pull 2>&1' |
| 80 | call execute_command_line(trim(command), exitstat=status) |
| 81 | |
| 82 | success = (status == 0) |
| 83 | end subroutine git_pull |
| 84 | |
| 85 | subroutine git_tag(workspace_path, tag_name, tag_message, success) |
| 86 | character(len=*), intent(in) :: workspace_path |
| 87 | character(len=*), intent(in) :: tag_name |
| 88 | character(len=*), intent(in) :: tag_message |
| 89 | logical, intent(out) :: success |
| 90 | character(len=2048) :: command |
| 91 | integer :: status |
| 92 | |
| 93 | success = .false. |
| 94 | |
| 95 | if (len_trim(tag_name) == 0) then |
| 96 | write(error_unit, '(A)') 'Error: Empty tag name' |
| 97 | return |
| 98 | end if |
| 99 | |
| 100 | if (len_trim(tag_message) > 0) then |
| 101 | ! Create annotated tag with message |
| 102 | write(command, '(A,A,A,A,A,A,A)') 'cd "', trim(workspace_path), & |
| 103 | '" && git tag -a "', trim(tag_name), '" -m "', trim(tag_message), '" 2>&1' |
| 104 | else |
| 105 | ! Create lightweight tag (no message) |
| 106 | write(command, '(A,A,A,A,A)') 'cd "', trim(workspace_path), & |
| 107 | '" && git tag "', trim(tag_name), '" 2>&1' |
| 108 | end if |
| 109 | |
| 110 | call execute_command_line(trim(command), exitstat=status) |
| 111 | |
| 112 | if (status == 0) then |
| 113 | ! Also fetch after tagging to sync with remote |
| 114 | write(command, '(A,A,A)') 'cd "', trim(workspace_path), '" && git fetch --tags 2>&1' |
| 115 | call execute_command_line(trim(command), exitstat=status) |
| 116 | success = .true. |
| 117 | end if |
| 118 | end subroutine git_tag |
| 119 | |
| 120 | subroutine git_push_tag(workspace_path, tag_name, success) |
| 121 | character(len=*), intent(in) :: workspace_path |
| 122 | character(len=*), intent(in) :: tag_name |
| 123 | logical, intent(out) :: success |
| 124 | character(len=1024) :: command |
| 125 | integer :: status |
| 126 | |
| 127 | success = .false. |
| 128 | |
| 129 | if (len_trim(tag_name) == 0) then |
| 130 | write(error_unit, '(A)') 'Error: Empty tag name' |
| 131 | return |
| 132 | end if |
| 133 | |
| 134 | ! Push the specific tag to origin |
| 135 | write(command, '(A,A,A,A,A)') 'cd "', trim(workspace_path), & |
| 136 | '" && git push origin "', trim(tag_name), '" 2>&1' |
| 137 | call execute_command_line(trim(command), exitstat=status) |
| 138 | |
| 139 | success = (status == 0) |
| 140 | end subroutine git_push_tag |
| 141 | |
| 142 | subroutine git_check_upstream(workspace_path, has_upstream) |
| 143 | character(len=*), intent(in) :: workspace_path |
| 144 | logical, intent(out) :: has_upstream |
| 145 | character(len=1024) :: command |
| 146 | integer :: status |
| 147 | |
| 148 | write(command, '(A,A,A)') 'cd "', trim(workspace_path), & |
| 149 | '" && git rev-parse --abbrev-ref @{upstream} > /dev/null 2>&1' |
| 150 | call execute_command_line(trim(command), exitstat=status) |
| 151 | |
| 152 | has_upstream = (status == 0) |
| 153 | end subroutine git_check_upstream |
| 154 | |
| 155 | subroutine git_diff_file(workspace_path, file_path, diff_content, branch_name, success) |
| 156 | character(len=*), intent(in) :: workspace_path |
| 157 | character(len=*), intent(in) :: file_path |
| 158 | character(len=:), allocatable, intent(out) :: diff_content |
| 159 | character(len=*), intent(out) :: branch_name |
| 160 | logical, intent(out) :: success |
| 161 | character(len=2048) :: command |
| 162 | character(len=512) :: temp_file, line |
| 163 | integer :: status, unit_num, ios |
| 164 | integer :: total_size, current_pos |
| 165 | |
| 166 | success = .false. |
| 167 | branch_name = '' |
| 168 | |
| 169 | ! Get current branch name |
| 170 | temp_file = '/tmp/fac_branch.tmp' |
| 171 | write(command, '(A,A,A,A,A)') 'cd "', trim(workspace_path), & |
| 172 | '" && git rev-parse --abbrev-ref HEAD > "', trim(temp_file), '" 2>&1' |
| 173 | call execute_command_line(trim(command), exitstat=status) |
| 174 | |
| 175 | if (status == 0) then |
| 176 | open(newunit=unit_num, file=trim(temp_file), status='old', action='read', iostat=ios) |
| 177 | if (ios == 0) then |
| 178 | read(unit_num, '(A)', iostat=ios) branch_name |
| 179 | close(unit_num) |
| 180 | end if |
| 181 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 182 | end if |
| 183 | |
| 184 | ! Get diff output |
| 185 | temp_file = '/tmp/fac_diff.tmp' |
| 186 | write(command, '(A,A,A,A,A,A,A)') 'cd "', trim(workspace_path), & |
| 187 | '" && git diff HEAD -- "', trim(file_path), '" > "', trim(temp_file), '" 2>&1' |
| 188 | call execute_command_line(trim(command), exitstat=status) |
| 189 | |
| 190 | if (status /= 0) then |
| 191 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 192 | diff_content = '' |
| 193 | return |
| 194 | end if |
| 195 | |
| 196 | ! Read diff content from temp file |
| 197 | open(newunit=unit_num, file=trim(temp_file), status='old', action='read', iostat=ios) |
| 198 | if (ios /= 0) then |
| 199 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 200 | diff_content = '' |
| 201 | return |
| 202 | end if |
| 203 | |
| 204 | ! First pass: calculate total size needed |
| 205 | total_size = 0 |
| 206 | do |
| 207 | read(unit_num, '(A)', iostat=ios) line |
| 208 | if (ios /= 0) exit |
| 209 | total_size = total_size + len_trim(line) + 1 ! +1 for newline |
| 210 | end do |
| 211 | |
| 212 | if (total_size == 0) then |
| 213 | ! No changes |
| 214 | close(unit_num) |
| 215 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 216 | diff_content = '(no changes)' |
| 217 | success = .true. |
| 218 | return |
| 219 | end if |
| 220 | |
| 221 | ! Allocate string with exact size needed |
| 222 | allocate(character(len=total_size) :: diff_content) |
| 223 | current_pos = 1 |
| 224 | |
| 225 | ! Second pass: read content into allocated string |
| 226 | rewind(unit_num) |
| 227 | do |
| 228 | read(unit_num, '(A)', iostat=ios) line |
| 229 | if (ios /= 0) exit |
| 230 | |
| 231 | ! Append line and newline |
| 232 | if (len_trim(line) > 0) then |
| 233 | ! Non-empty line |
| 234 | if (current_pos + len_trim(line) - 1 <= total_size) then |
| 235 | diff_content(current_pos:current_pos+len_trim(line)-1) = trim(line) |
| 236 | current_pos = current_pos + len_trim(line) |
| 237 | end if |
| 238 | end if |
| 239 | |
| 240 | ! Add newline after each line (including empty lines) |
| 241 | if (current_pos <= total_size) then |
| 242 | diff_content(current_pos:current_pos) = new_line('a') |
| 243 | current_pos = current_pos + 1 |
| 244 | end if |
| 245 | end do |
| 246 | |
| 247 | close(unit_num) |
| 248 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 249 | success = .true. |
| 250 | end subroutine git_diff_file |
| 251 | |
| 252 | subroutine git_list_tags(workspace_path, tags, n_tags) |
| 253 | character(len=*), intent(in) :: workspace_path |
| 254 | character(len=256), allocatable, intent(out) :: tags(:) |
| 255 | integer, intent(out) :: n_tags |
| 256 | character(len=1024) :: command, temp_file |
| 257 | character(len=256) :: line |
| 258 | integer :: status, unit_num, ios, i, max_tags |
| 259 | character(len=256), allocatable :: temp_tags(:) |
| 260 | |
| 261 | n_tags = 0 |
| 262 | max_tags = 100 ! Initial allocation |
| 263 | |
| 264 | ! Get tags sorted by creation date (newest first) |
| 265 | temp_file = '/tmp/fac_tags.tmp' |
| 266 | write(command, '(A,A,A,A,A)') 'cd "', trim(workspace_path), & |
| 267 | '" && git tag --sort=-creatordate > "', trim(temp_file), '" 2>&1' |
| 268 | call execute_command_line(trim(command), exitstat=status) |
| 269 | |
| 270 | if (status /= 0) then |
| 271 | ! No tags or error |
| 272 | allocate(tags(0)) |
| 273 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 274 | return |
| 275 | end if |
| 276 | |
| 277 | ! Count tags |
| 278 | open(newunit=unit_num, file=trim(temp_file), status='old', action='read', iostat=ios) |
| 279 | if (ios /= 0) then |
| 280 | allocate(tags(0)) |
| 281 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 282 | return |
| 283 | end if |
| 284 | |
| 285 | ! Read tags into temporary array |
| 286 | allocate(temp_tags(max_tags)) |
| 287 | do |
| 288 | read(unit_num, '(A)', iostat=ios) line |
| 289 | if (ios /= 0) exit |
| 290 | if (len_trim(line) > 0) then |
| 291 | n_tags = n_tags + 1 |
| 292 | if (n_tags > max_tags) then |
| 293 | ! Reallocate if needed |
| 294 | max_tags = max_tags * 2 |
| 295 | deallocate(temp_tags) |
| 296 | allocate(temp_tags(max_tags)) |
| 297 | end if |
| 298 | temp_tags(n_tags) = trim(line) |
| 299 | end if |
| 300 | end do |
| 301 | close(unit_num) |
| 302 | |
| 303 | ! Copy to output array |
| 304 | if (n_tags > 0) then |
| 305 | allocate(tags(n_tags)) |
| 306 | do i = 1, n_tags |
| 307 | tags(i) = temp_tags(i) |
| 308 | end do |
| 309 | else |
| 310 | allocate(tags(0)) |
| 311 | end if |
| 312 | |
| 313 | deallocate(temp_tags) |
| 314 | call execute_command_line('rm -f "' // trim(temp_file) // '"') |
| 315 | end subroutine git_list_tags |
| 316 | |
| 317 | end module git_ops_module |
| 318 |