| 1 | ! ============================================================================== |
| 2 | ! Module: read_builtin |
| 3 | ! Purpose: Interactive read built-in with options and prompts |
| 4 | ! ============================================================================== |
| 5 | module read_builtin |
| 6 | use shell_types |
| 7 | use variables |
| 8 | use iso_fortran_env, only: input_unit, output_unit, error_unit, & |
| 9 | IOSTAT_EOR, IOSTAT_END |
| 10 | implicit none |
| 11 | |
| 12 | contains |
| 13 | |
| 14 | subroutine builtin_read(cmd, shell) |
| 15 | type(command_t), intent(in) :: cmd |
| 16 | type(shell_state_t), intent(inout) :: shell |
| 17 | |
| 18 | character(len=256) :: prompt, var_name, delimiter |
| 19 | character(len=4096) :: input_line |
| 20 | integer :: timeout_sec, arg_index, actual_input_len |
| 21 | logical :: silent_mode, raw_mode, use_prompt, use_timeout, use_delimiter |
| 22 | logical :: use_array, use_nchars |
| 23 | integer :: nchars |
| 24 | |
| 25 | ! Initialize options |
| 26 | prompt = '' |
| 27 | var_name = 'REPLY' ! default variable |
| 28 | delimiter = char(10) ! newline |
| 29 | timeout_sec = 0 |
| 30 | silent_mode = .false. |
| 31 | raw_mode = .false. |
| 32 | use_prompt = .false. |
| 33 | use_timeout = .false. |
| 34 | use_delimiter = .false. |
| 35 | use_array = .false. |
| 36 | use_nchars = .false. |
| 37 | nchars = 0 |
| 38 | |
| 39 | ! Parse options |
| 40 | arg_index = 2 |
| 41 | do while (arg_index <= cmd%num_tokens) |
| 42 | select case (trim(cmd%tokens(arg_index))) |
| 43 | case ('-p') |
| 44 | ! Prompt |
| 45 | if (arg_index + 1 <= cmd%num_tokens) then |
| 46 | prompt = cmd%tokens(arg_index + 1) |
| 47 | use_prompt = .true. |
| 48 | arg_index = arg_index + 2 |
| 49 | else |
| 50 | write(error_unit, '(a)') 'read: -p option requires an argument' |
| 51 | shell%last_exit_status = 1 |
| 52 | return |
| 53 | end if |
| 54 | case ('-t') |
| 55 | ! Timeout |
| 56 | if (arg_index + 1 <= cmd%num_tokens) then |
| 57 | read(cmd%tokens(arg_index + 1), *, iostat=arg_index) timeout_sec |
| 58 | if (arg_index /= 0) then |
| 59 | write(error_unit, '(a)') 'read: invalid timeout value' |
| 60 | shell%last_exit_status = 1 |
| 61 | return |
| 62 | end if |
| 63 | use_timeout = .true. |
| 64 | arg_index = arg_index + 2 |
| 65 | else |
| 66 | write(error_unit, '(a)') 'read: -t option requires an argument' |
| 67 | shell%last_exit_status = 1 |
| 68 | return |
| 69 | end if |
| 70 | case ('-s') |
| 71 | ! Silent mode (no echo) |
| 72 | silent_mode = .true. |
| 73 | arg_index = arg_index + 1 |
| 74 | case ('-r') |
| 75 | ! Raw mode (don't interpret backslashes) |
| 76 | raw_mode = .true. |
| 77 | arg_index = arg_index + 1 |
| 78 | case ('-d') |
| 79 | ! Delimiter |
| 80 | if (arg_index + 1 <= cmd%num_tokens) then |
| 81 | delimiter = cmd%tokens(arg_index + 1)(1:1) |
| 82 | use_delimiter = .true. |
| 83 | arg_index = arg_index + 2 |
| 84 | else |
| 85 | write(error_unit, '(a)') 'read: -d option requires an argument' |
| 86 | shell%last_exit_status = 1 |
| 87 | return |
| 88 | end if |
| 89 | case ('-a') |
| 90 | ! Array mode |
| 91 | if (arg_index + 1 <= cmd%num_tokens) then |
| 92 | var_name = cmd%tokens(arg_index + 1) |
| 93 | use_array = .true. |
| 94 | arg_index = arg_index + 2 |
| 95 | else |
| 96 | write(error_unit, '(a)') 'read: -a option requires an argument' |
| 97 | shell%last_exit_status = 1 |
| 98 | return |
| 99 | end if |
| 100 | case ('-n') |
| 101 | ! Read n characters |
| 102 | if (arg_index + 1 <= cmd%num_tokens) then |
| 103 | read(cmd%tokens(arg_index + 1), *, iostat=arg_index) nchars |
| 104 | if (arg_index /= 0) then |
| 105 | write(error_unit, '(a)') 'read: invalid character count' |
| 106 | shell%last_exit_status = 1 |
| 107 | return |
| 108 | end if |
| 109 | use_nchars = .true. |
| 110 | arg_index = arg_index + 2 |
| 111 | else |
| 112 | write(error_unit, '(a)') 'read: -n option requires an argument' |
| 113 | shell%last_exit_status = 1 |
| 114 | return |
| 115 | end if |
| 116 | case default |
| 117 | ! Variable names - don't exit, let the loop collect all of them |
| 118 | if (cmd%tokens(arg_index)(1:1) /= '-') then |
| 119 | ! Found first variable name, mark where variables start |
| 120 | if (var_name == 'REPLY') then |
| 121 | var_name = cmd%tokens(arg_index) ! Save first var for single-var case |
| 122 | end if |
| 123 | exit ! Exit to start processing variables |
| 124 | else |
| 125 | write(error_unit, '(a,a)') 'read: unknown option: ', trim(cmd%tokens(arg_index)) |
| 126 | shell%last_exit_status = 1 |
| 127 | return |
| 128 | end if |
| 129 | end select |
| 130 | end do |
| 131 | |
| 132 | ! Display prompt if specified |
| 133 | if (use_prompt) then |
| 134 | write(output_unit, '(a)', advance='no') trim(prompt) |
| 135 | end if |
| 136 | |
| 137 | ! Read input based on options |
| 138 | block |
| 139 | logical :: eof_reached |
| 140 | eof_reached = .false. |
| 141 | |
| 142 | actual_input_len = 0 |
| 143 | if (use_nchars) then |
| 144 | call read_n_characters(nchars, input_line) |
| 145 | actual_input_len = len_trim(input_line) |
| 146 | else if (use_delimiter) then |
| 147 | call read_until_delimiter(delimiter, input_line) |
| 148 | actual_input_len = len_trim(input_line) |
| 149 | else if (use_timeout) then |
| 150 | call read_with_timeout(timeout_sec, input_line, & |
| 151 | shell%last_exit_status) |
| 152 | actual_input_len = len_trim(input_line) |
| 153 | if (shell%last_exit_status /= 0) return |
| 154 | else |
| 155 | call read_line_input(input_line, eof_reached, raw_mode, & |
| 156 | actual_input_len) |
| 157 | end if |
| 158 | |
| 159 | ! Process backslash escapes (but not continuation, which was handled above) |
| 160 | if (.not. raw_mode) then |
| 161 | call process_backslash_escapes(input_line) |
| 162 | end if |
| 163 | |
| 164 | ! Store result in variable(s) |
| 165 | if (use_array) then |
| 166 | call store_array_result(shell, var_name, input_line) |
| 167 | else if (arg_index < cmd%num_tokens) then |
| 168 | ! Multiple variables: start from arg_index (first variable) |
| 169 | call store_multiple_variables(shell, cmd%tokens, arg_index, cmd%num_tokens, input_line) |
| 170 | else |
| 171 | ! Single variable — strip leading and trailing IFS whitespace |
| 172 | ! When IFS is explicitly set to empty, preserve all whitespace |
| 173 | ! When IFS is explicitly set to empty (ifs_len==0), |
| 174 | ! preserve all whitespace. ifs_len==-1 means default. |
| 175 | if (shell%ifs_len == 0) then |
| 176 | call set_shell_variable(shell, var_name, & |
| 177 | input_line(:actual_input_len), actual_input_len) |
| 178 | else |
| 179 | call set_shell_variable(shell, var_name, & |
| 180 | trim(adjustl(input_line))) |
| 181 | end if |
| 182 | end if |
| 183 | |
| 184 | ! Set exit status: 1 if EOF reached without reading any data, 0 otherwise |
| 185 | if (eof_reached .and. len_trim(input_line) == 0) then |
| 186 | shell%last_exit_status = 1 |
| 187 | else |
| 188 | shell%last_exit_status = 0 |
| 189 | end if |
| 190 | end block |
| 191 | end subroutine |
| 192 | |
| 193 | subroutine read_line_input(input_line, eof_reached, raw_mode, & |
| 194 | input_length) |
| 195 | character(len=*), intent(out) :: input_line |
| 196 | logical, intent(out), optional :: eof_reached |
| 197 | logical, intent(in), optional :: raw_mode |
| 198 | integer, intent(out), optional :: input_length |
| 199 | integer :: iostat, line_len, nchars |
| 200 | character(len=4096) :: continuation_line |
| 201 | logical :: is_raw |
| 202 | |
| 203 | is_raw = .false. |
| 204 | if (present(raw_mode)) is_raw = raw_mode |
| 205 | |
| 206 | ! Use non-advancing I/O to get actual character count |
| 207 | input_line = '' |
| 208 | nchars = 0 |
| 209 | read(input_unit, '(a)', iostat=iostat, advance='no', & |
| 210 | size=nchars) input_line |
| 211 | if (iostat == IOSTAT_EOR .or. iostat == 0) then |
| 212 | if (present(eof_reached)) eof_reached = .false. |
| 213 | if (present(input_length)) input_length = nchars |
| 214 | else if (iostat == IOSTAT_END) then |
| 215 | input_line = '' |
| 216 | if (present(eof_reached)) eof_reached = .true. |
| 217 | if (present(input_length)) input_length = 0 |
| 218 | return |
| 219 | else |
| 220 | input_line = '' |
| 221 | if (present(eof_reached)) eof_reached = .true. |
| 222 | if (present(input_length)) input_length = 0 |
| 223 | return |
| 224 | end if |
| 225 | |
| 226 | ! POSIX: Without -r, backslash at end of line continues to next line |
| 227 | if (.not. is_raw) then |
| 228 | do while (.true.) |
| 229 | line_len = len_trim(input_line) |
| 230 | if (line_len == 0) exit |
| 231 | ! Check if line ends with backslash |
| 232 | if (input_line(line_len:line_len) == '\') then |
| 233 | ! Remove trailing backslash |
| 234 | input_line(line_len:line_len) = ' ' |
| 235 | ! Read next line |
| 236 | read(input_unit, '(a)', iostat=iostat) continuation_line |
| 237 | if (iostat /= 0) exit |
| 238 | ! Append continuation line |
| 239 | input_line = trim(input_line) // trim(continuation_line) |
| 240 | if (present(input_length)) then |
| 241 | input_length = len_trim(input_line) |
| 242 | end if |
| 243 | else |
| 244 | exit |
| 245 | end if |
| 246 | end do |
| 247 | end if |
| 248 | end subroutine |
| 249 | |
| 250 | subroutine read_n_characters(n, input_line) |
| 251 | integer, intent(in) :: n |
| 252 | character(len=*), intent(out) :: input_line |
| 253 | |
| 254 | integer :: i, iostat |
| 255 | character :: ch |
| 256 | |
| 257 | input_line = '' |
| 258 | |
| 259 | do i = 1, min(n, len(input_line)) |
| 260 | read(input_unit, '(a1)', iostat=iostat) ch |
| 261 | if (iostat /= 0) exit |
| 262 | input_line(i:i) = ch |
| 263 | end do |
| 264 | end subroutine |
| 265 | |
| 266 | subroutine read_until_delimiter(delimiter, input_line) |
| 267 | character, intent(in) :: delimiter |
| 268 | character(len=*), intent(out) :: input_line |
| 269 | |
| 270 | character :: ch |
| 271 | integer :: pos, iostat |
| 272 | |
| 273 | input_line = '' |
| 274 | pos = 1 |
| 275 | |
| 276 | do while (pos <= len(input_line)) |
| 277 | read(input_unit, '(a1)', iostat=iostat) ch |
| 278 | if (iostat /= 0) exit |
| 279 | |
| 280 | if (ch == delimiter) then |
| 281 | exit |
| 282 | end if |
| 283 | |
| 284 | input_line(pos:pos) = ch |
| 285 | pos = pos + 1 |
| 286 | end do |
| 287 | end subroutine |
| 288 | |
| 289 | subroutine read_with_timeout(timeout_sec, input_line, exit_status) |
| 290 | integer, intent(in) :: timeout_sec |
| 291 | character(len=*), intent(out) :: input_line |
| 292 | integer, intent(out) :: exit_status |
| 293 | integer :: iostat |
| 294 | |
| 295 | ! Simplified timeout implementation |
| 296 | ! In a real implementation, this would use select() or similar with timeout_sec |
| 297 | input_line = '' |
| 298 | exit_status = 1 ! Timeout |
| 299 | if (.false.) print *, timeout_sec ! Silence unused warning (timeout not yet implemented) |
| 300 | |
| 301 | ! For now, just read normally |
| 302 | read(input_unit, '(a)', iostat=iostat) input_line |
| 303 | if (iostat == 0) then |
| 304 | exit_status = 0 |
| 305 | end if |
| 306 | end subroutine |
| 307 | |
| 308 | subroutine process_backslash_escapes(input_line) |
| 309 | character(len=*), intent(inout) :: input_line |
| 310 | |
| 311 | character(len=len(input_line)) :: processed |
| 312 | integer :: i, j |
| 313 | |
| 314 | ! POSIX: Without -r, backslash removes itself and preserves the following char |
| 315 | ! This is NOT like printf escapes - \n becomes literal 'n', not newline |
| 316 | ! The only special case is \<newline> which is handled in read_line_input |
| 317 | |
| 318 | processed = '' |
| 319 | i = 1 |
| 320 | j = 1 |
| 321 | |
| 322 | do while (i <= len_trim(input_line)) |
| 323 | if (input_line(i:i) == '\' .and. i < len_trim(input_line)) then |
| 324 | ! Skip the backslash, keep the next character literally |
| 325 | i = i + 1 |
| 326 | processed(j:j) = input_line(i:i) |
| 327 | j = j + 1 |
| 328 | i = i + 1 |
| 329 | else |
| 330 | processed(j:j) = input_line(i:i) |
| 331 | i = i + 1 |
| 332 | j = j + 1 |
| 333 | end if |
| 334 | end do |
| 335 | |
| 336 | input_line = processed |
| 337 | end subroutine |
| 338 | |
| 339 | subroutine store_array_result(shell, var_name, input_line) |
| 340 | type(shell_state_t), intent(inout) :: shell |
| 341 | character(len=*), intent(in) :: var_name, input_line |
| 342 | |
| 343 | character(len=256) :: words(50) |
| 344 | integer :: word_count, start_pos, pos |
| 345 | |
| 346 | word_count = 0 |
| 347 | pos = 1 |
| 348 | start_pos = 1 |
| 349 | |
| 350 | ! Split input into words |
| 351 | do while (pos <= len_trim(input_line)) |
| 352 | if (input_line(pos:pos) == ' ' .or. input_line(pos:pos) == char(9)) then |
| 353 | if (pos > start_pos .and. word_count < 50) then |
| 354 | word_count = word_count + 1 |
| 355 | words(word_count) = input_line(start_pos:pos-1) |
| 356 | end if |
| 357 | start_pos = pos + 1 |
| 358 | end if |
| 359 | pos = pos + 1 |
| 360 | end do |
| 361 | |
| 362 | ! Handle last word |
| 363 | if (start_pos <= len_trim(input_line) .and. word_count < 50) then |
| 364 | word_count = word_count + 1 |
| 365 | words(word_count) = input_line(start_pos:) |
| 366 | end if |
| 367 | |
| 368 | ! Store as array |
| 369 | if (word_count > 0) then |
| 370 | call set_array_variable(shell, var_name, words, word_count) |
| 371 | end if |
| 372 | end subroutine |
| 373 | |
| 374 | subroutine store_multiple_variables(shell, tokens, start_arg, num_tokens, input_line) |
| 375 | type(shell_state_t), intent(inout) :: shell |
| 376 | character(len=*), intent(in) :: tokens(:) |
| 377 | integer, intent(in) :: start_arg, num_tokens |
| 378 | character(len=*), intent(in) :: input_line |
| 379 | |
| 380 | character(len=256) :: words(20) |
| 381 | character(len=:), allocatable :: ifs_value |
| 382 | integer :: word_count, var_count, i, pos, start_pos, input_len |
| 383 | logical :: is_ifs_char |
| 384 | |
| 385 | ! Get IFS value (default is space, tab, newline) |
| 386 | ifs_value = get_shell_variable(shell, 'IFS') |
| 387 | if (len_trim(ifs_value) == 0 .or. trim(ifs_value) == ' \t\n') then |
| 388 | ! Default IFS: space, tab, newline as actual characters |
| 389 | ifs_value = ' ' // char(9) // char(10) |
| 390 | end if |
| 391 | |
| 392 | word_count = 0 |
| 393 | var_count = num_tokens - start_arg + 1 |
| 394 | input_len = len_trim(input_line) |
| 395 | pos = 1 |
| 396 | |
| 397 | ! Skip leading IFS whitespace |
| 398 | do while (pos <= input_len) |
| 399 | if (index(ifs_value, input_line(pos:pos)) > 0) then |
| 400 | pos = pos + 1 |
| 401 | else |
| 402 | exit |
| 403 | end if |
| 404 | end do |
| 405 | |
| 406 | start_pos = pos |
| 407 | |
| 408 | ! Split input by IFS characters |
| 409 | ! POSIX: For non-whitespace IFS chars, consecutive delimiters create empty fields |
| 410 | do while (pos <= input_len .and. word_count < var_count) |
| 411 | is_ifs_char = (index(ifs_value, input_line(pos:pos)) > 0) |
| 412 | |
| 413 | if (is_ifs_char) then |
| 414 | ! Record the word before this IFS char (may be empty if consecutive IFS) |
| 415 | if (pos > start_pos) then |
| 416 | word_count = word_count + 1 |
| 417 | words(word_count) = input_line(start_pos:pos-1) |
| 418 | else |
| 419 | ! Empty field (consecutive IFS chars for non-whitespace delimiters) |
| 420 | ! Only create empty field for non-whitespace IFS characters |
| 421 | if (index(' ' // char(9) // char(10), input_line(pos:pos)) == 0) then |
| 422 | word_count = word_count + 1 |
| 423 | words(word_count) = '' |
| 424 | end if |
| 425 | end if |
| 426 | |
| 427 | ! If we've filled all but the last variable, assign remaining input to last var |
| 428 | if (word_count >= var_count - 1) then |
| 429 | ! Skip current IFS char |
| 430 | pos = pos + 1 |
| 431 | ! Skip only whitespace IFS chars before remainder |
| 432 | do while (pos <= input_len) |
| 433 | if (index(' ' // char(9) // char(10), input_line(pos:pos)) > 0 .and. & |
| 434 | index(ifs_value, input_line(pos:pos)) > 0) then |
| 435 | pos = pos + 1 |
| 436 | else |
| 437 | exit |
| 438 | end if |
| 439 | end do |
| 440 | if (pos <= input_len) then |
| 441 | word_count = word_count + 1 |
| 442 | words(word_count) = input_line(pos:input_len) |
| 443 | end if |
| 444 | exit |
| 445 | end if |
| 446 | |
| 447 | ! Skip this IFS char |
| 448 | pos = pos + 1 |
| 449 | |
| 450 | ! Only skip additional consecutive whitespace IFS chars |
| 451 | do while (pos <= input_len) |
| 452 | if (index(' ' // char(9) // char(10), input_line(pos:pos)) > 0 .and. & |
| 453 | index(ifs_value, input_line(pos:pos)) > 0) then |
| 454 | pos = pos + 1 |
| 455 | else |
| 456 | exit |
| 457 | end if |
| 458 | end do |
| 459 | start_pos = pos |
| 460 | cycle |
| 461 | end if |
| 462 | |
| 463 | ! Not an IFS char, keep scanning |
| 464 | pos = pos + 1 |
| 465 | end do |
| 466 | |
| 467 | ! Handle last word if we haven't filled all variables yet |
| 468 | if (word_count < var_count .and. start_pos <= input_len) then |
| 469 | word_count = word_count + 1 |
| 470 | words(word_count) = input_line(start_pos:input_len) |
| 471 | end if |
| 472 | |
| 473 | ! Assign to variables |
| 474 | do i = start_arg, num_tokens |
| 475 | if (i - start_arg + 1 <= word_count) then |
| 476 | call set_shell_variable(shell, trim(tokens(i)), trim(words(i - start_arg + 1))) |
| 477 | else |
| 478 | call set_shell_variable(shell, trim(tokens(i)), '') |
| 479 | end if |
| 480 | end do |
| 481 | end subroutine |
| 482 | |
| 483 | end module read_builtin |