| 1 | program ferp |
| 2 | !> FERP - Fortran Expression Regular Print |
| 3 | !> A GNU grep clone written in Modern Fortran |
| 4 | use ferp_kinds |
| 5 | use ferp_options |
| 6 | use ferp_cli |
| 7 | use ferp_io |
| 8 | use ferp_dir |
| 9 | use ferp_matcher |
| 10 | use, intrinsic :: iso_c_binding, only: c_int |
| 11 | use, intrinsic :: iso_fortran_env, only: error_unit |
| 12 | #ifdef _OPENMP |
| 13 | use omp_lib |
| 14 | #endif |
| 15 | implicit none |
| 16 | |
| 17 | interface |
| 18 | subroutine c_exit(status) bind(C, name="exit") |
| 19 | import :: c_int |
| 20 | integer(c_int), value :: status |
| 21 | end subroutine c_exit |
| 22 | end interface |
| 23 | |
| 24 | type(grep_options) :: opts |
| 25 | character(len=max_pattern_len), allocatable :: patterns(:) |
| 26 | character(len=max_path_len), allocatable :: files(:) |
| 27 | character(len=max_path_len), allocatable :: expanded_files(:) |
| 28 | type(input_source) :: src |
| 29 | type(compiled_patterns_t) :: compiled |
| 30 | integer :: ierr, i, j, num_collected |
| 31 | integer, parameter :: MAX_PATTERNS = 1000 |
| 32 | character(len=max_path_len), allocatable :: collected_files(:) |
| 33 | character(len=max_path_len), save :: exclude_patterns(MAX_PATTERNS) |
| 34 | character(len=max_path_len), save :: include_patterns(MAX_PATTERNS) |
| 35 | integer :: num_exclude_patterns, num_include_patterns |
| 36 | logical :: any_match, file_match |
| 37 | logical :: found_early ! For quiet mode early termination in parallel |
| 38 | logical :: has_error ! Track if any errors occurred (for exit code 2) |
| 39 | |
| 40 | ! Parse command-line arguments |
| 41 | call parse_arguments(opts, patterns, files, ierr) |
| 42 | if (ierr /= 0) then |
| 43 | call c_exit(2_c_int) |
| 44 | end if |
| 45 | |
| 46 | ! Read exclude patterns from file if specified |
| 47 | num_exclude_patterns = 0 |
| 48 | if (len_trim(opts%exclude_from_file) > 0) then |
| 49 | call read_patterns_from_file(trim(opts%exclude_from_file), exclude_patterns, & |
| 50 | num_exclude_patterns, ierr) |
| 51 | if (ierr /= 0) then |
| 52 | write(error_unit, '(A)') 'ferp: ' // trim(opts%exclude_from_file) // & |
| 53 | ': No such file or directory' |
| 54 | call c_exit(2_c_int) |
| 55 | end if |
| 56 | end if |
| 57 | |
| 58 | ! Read include patterns from file if specified |
| 59 | num_include_patterns = 0 |
| 60 | if (len_trim(opts%include_from_file) > 0) then |
| 61 | call read_patterns_from_file(trim(opts%include_from_file), include_patterns, & |
| 62 | num_include_patterns, ierr) |
| 63 | if (ierr /= 0) then |
| 64 | write(error_unit, '(A)') 'ferp: ' // trim(opts%include_from_file) // & |
| 65 | ': No such file or directory' |
| 66 | call c_exit(2_c_int) |
| 67 | end if |
| 68 | end if |
| 69 | |
| 70 | ! Handle recursive mode - expand directories to file lists |
| 71 | if (opts%recursive) then |
| 72 | if (size(files) == 0) then |
| 73 | ! Default to current directory when no files specified with -r |
| 74 | deallocate(files) |
| 75 | allocate(files(1)) |
| 76 | files(1) = '.' |
| 77 | end if |
| 78 | |
| 79 | ! Allocate buffer for collected files (100K files per directory scan) |
| 80 | allocate(collected_files(100000)) |
| 81 | |
| 82 | ! Expand all paths (files stay as-is, directories get expanded) |
| 83 | allocate(expanded_files(0)) |
| 84 | do i = 1, size(files) |
| 85 | call collect_files(trim(files(i)), collected_files, num_collected, & |
| 86 | .true., opts%dereference_recursive, & |
| 87 | opts%include_globs, opts%num_include_globs, & |
| 88 | opts%exclude_globs, opts%num_exclude_globs, & |
| 89 | opts%exclude_dirs, opts%num_exclude_dirs) |
| 90 | do j = 1, num_collected |
| 91 | call append_file_to_list(expanded_files, collected_files(j)) |
| 92 | end do |
| 93 | end do |
| 94 | |
| 95 | ! Replace files with expanded list |
| 96 | deallocate(collected_files) ! Free temporary buffer |
| 97 | deallocate(files) |
| 98 | allocate(files(size(expanded_files))) |
| 99 | files = expanded_files |
| 100 | deallocate(expanded_files) |
| 101 | |
| 102 | ! Update multiple_files flag |
| 103 | opts%multiple_files = (size(files) > 1) |
| 104 | if (opts%multiple_files .and. .not. opts%hide_filename) then |
| 105 | opts%show_filename = .true. |
| 106 | end if |
| 107 | end if |
| 108 | |
| 109 | ! Compile patterns (for all modes - regex uses NFA/PCRE, fixed uses Boyer-Moore) |
| 110 | call compile_patterns(patterns, opts, compiled, ierr) |
| 111 | if (ierr /= 0) then |
| 112 | write(error_unit, '(A)') 'ferp: Invalid regular expression' |
| 113 | call c_exit(2_c_int) |
| 114 | end if |
| 115 | |
| 116 | any_match = .false. |
| 117 | found_early = .false. |
| 118 | has_error = .false. |
| 119 | |
| 120 | ! Process input sources |
| 121 | if (size(files) == 0) then |
| 122 | ! No files specified - read from stdin |
| 123 | opts%reading_stdin = .true. |
| 124 | if (src%open('-', null_data=opts%null_data)) then |
| 125 | src%filename = opts%label ! Use --label if provided |
| 126 | any_match = process_source(src, patterns, opts, compiled) |
| 127 | call src%close() |
| 128 | end if |
| 129 | else |
| 130 | ! Process each file with OpenMP parallelization (release builds) |
| 131 | ! Thread-safe: all buffers are now dynamically allocated per-thread |
| 132 | !$omp parallel do default(shared) private(src, file_match) & |
| 133 | !$omp& reduction(.or.:any_match,has_error) schedule(dynamic) |
| 134 | do i = 1, size(files) |
| 135 | ! Early termination check for quiet mode |
| 136 | if (opts%quiet .and. found_early) cycle |
| 137 | |
| 138 | ! Check for directory and handle according to dir_action |
| 139 | if (.not. opts%recursive .and. is_directory(trim(files(i)))) then |
| 140 | select case (opts%dir_action) |
| 141 | case (DIR_SKIP) |
| 142 | cycle ! Skip directories silently |
| 143 | case (DIR_RECURSE) |
| 144 | ! Note: In parallel mode, we can't modify opts |
| 145 | ! This path is rare - usually -r is specified explicitly |
| 146 | cycle |
| 147 | case default ! DIR_READ |
| 148 | ! Print error message and skip (like grep) |
| 149 | if (.not. opts%no_messages) then |
| 150 | !$omp critical(error_output) |
| 151 | write(error_unit, '(A)') 'ferp: ' // trim(files(i)) // ': Is a directory' |
| 152 | !$omp end critical(error_output) |
| 153 | end if |
| 154 | has_error = .true. |
| 155 | cycle |
| 156 | end select |
| 157 | end if |
| 158 | |
| 159 | ! Check include patterns from file |
| 160 | if (num_include_patterns > 0) then |
| 161 | if (.not. matches_any_pattern(trim(files(i)), include_patterns, num_include_patterns)) then |
| 162 | cycle |
| 163 | end if |
| 164 | end if |
| 165 | |
| 166 | ! Check exclude patterns from file |
| 167 | if (num_exclude_patterns > 0) then |
| 168 | if (matches_any_pattern(trim(files(i)), exclude_patterns, num_exclude_patterns)) then |
| 169 | cycle |
| 170 | end if |
| 171 | end if |
| 172 | |
| 173 | ! Check for binary file BEFORE opening |
| 174 | if (.not. opts%text_mode) then |
| 175 | src%is_binary = check_binary_file(trim(files(i))) |
| 176 | if (src%is_binary .and. opts%ignore_binary) cycle |
| 177 | else |
| 178 | src%is_binary = .false. |
| 179 | end if |
| 180 | |
| 181 | if (src%open(trim(files(i)), opts%no_messages, opts%null_data)) then |
| 182 | ! No critical section here - output functions are thread-safe |
| 183 | file_match = process_source(src, patterns, opts, compiled) |
| 184 | if (file_match) then |
| 185 | any_match = .true. |
| 186 | ! Signal early termination for quiet mode |
| 187 | if (opts%quiet) found_early = .true. |
| 188 | end if |
| 189 | call src%close() |
| 190 | else |
| 191 | ! File open failed - set error flag |
| 192 | has_error = .true. |
| 193 | end if |
| 194 | end do |
| 195 | !$omp end parallel do |
| 196 | end if |
| 197 | |
| 198 | ! Clean up compiled patterns |
| 199 | call free_patterns(compiled) |
| 200 | |
| 201 | ! Exit with appropriate code |
| 202 | ! 0 = match found, 1 = no match, 2 = error |
| 203 | ! Note: grep returns 2 if there's any error, even with matches |
| 204 | if (has_error) then |
| 205 | call c_exit(2_c_int) |
| 206 | else if (any_match) then |
| 207 | call c_exit(0_c_int) |
| 208 | else |
| 209 | call c_exit(1_c_int) |
| 210 | end if |
| 211 | |
| 212 | contains |
| 213 | |
| 214 | subroutine append_file_to_list(file_list, filename) |
| 215 | !> Append a file to an allocatable file list |
| 216 | character(len=max_path_len), allocatable, intent(inout) :: file_list(:) |
| 217 | character(len=*), intent(in) :: filename |
| 218 | |
| 219 | character(len=max_path_len), allocatable :: temp(:) |
| 220 | integer :: n |
| 221 | |
| 222 | n = size(file_list) |
| 223 | allocate(temp(n + 1)) |
| 224 | if (n > 0) temp(1:n) = file_list |
| 225 | temp(n + 1) = filename |
| 226 | call move_alloc(temp, file_list) |
| 227 | end subroutine append_file_to_list |
| 228 | |
| 229 | end program ferp |
| 230 |