| 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 | |
| 39 | ! Parse command-line arguments |
| 40 | call parse_arguments(opts, patterns, files, ierr) |
| 41 | if (ierr /= 0) then |
| 42 | call c_exit(2_c_int) |
| 43 | end if |
| 44 | |
| 45 | ! Read exclude patterns from file if specified |
| 46 | num_exclude_patterns = 0 |
| 47 | if (len_trim(opts%exclude_from_file) > 0) then |
| 48 | call read_patterns_from_file(trim(opts%exclude_from_file), exclude_patterns, & |
| 49 | num_exclude_patterns, ierr) |
| 50 | if (ierr /= 0) then |
| 51 | write(error_unit, '(A)') 'ferp: ' // trim(opts%exclude_from_file) // & |
| 52 | ': No such file or directory' |
| 53 | call c_exit(2_c_int) |
| 54 | end if |
| 55 | end if |
| 56 | |
| 57 | ! Read include patterns from file if specified |
| 58 | num_include_patterns = 0 |
| 59 | if (len_trim(opts%include_from_file) > 0) then |
| 60 | call read_patterns_from_file(trim(opts%include_from_file), include_patterns, & |
| 61 | num_include_patterns, ierr) |
| 62 | if (ierr /= 0) then |
| 63 | write(error_unit, '(A)') 'ferp: ' // trim(opts%include_from_file) // & |
| 64 | ': No such file or directory' |
| 65 | call c_exit(2_c_int) |
| 66 | end if |
| 67 | end if |
| 68 | |
| 69 | ! Handle recursive mode - expand directories to file lists |
| 70 | if (opts%recursive) then |
| 71 | if (size(files) == 0) then |
| 72 | ! Default to current directory when no files specified with -r |
| 73 | deallocate(files) |
| 74 | allocate(files(1)) |
| 75 | files(1) = '.' |
| 76 | end if |
| 77 | |
| 78 | ! Allocate buffer for collected files (100K files per directory scan) |
| 79 | allocate(collected_files(100000)) |
| 80 | |
| 81 | ! Expand all paths (files stay as-is, directories get expanded) |
| 82 | allocate(expanded_files(0)) |
| 83 | do i = 1, size(files) |
| 84 | call collect_files(trim(files(i)), collected_files, num_collected, & |
| 85 | .true., opts%dereference_recursive, & |
| 86 | opts%include_globs, opts%num_include_globs, & |
| 87 | opts%exclude_globs, opts%num_exclude_globs, & |
| 88 | opts%exclude_dirs, opts%num_exclude_dirs) |
| 89 | do j = 1, num_collected |
| 90 | call append_file_to_list(expanded_files, collected_files(j)) |
| 91 | end do |
| 92 | end do |
| 93 | |
| 94 | ! Replace files with expanded list |
| 95 | deallocate(collected_files) ! Free temporary buffer |
| 96 | deallocate(files) |
| 97 | allocate(files(size(expanded_files))) |
| 98 | files = expanded_files |
| 99 | deallocate(expanded_files) |
| 100 | |
| 101 | ! Update multiple_files flag |
| 102 | opts%multiple_files = (size(files) > 1) |
| 103 | if (opts%multiple_files .and. .not. opts%hide_filename) then |
| 104 | opts%show_filename = .true. |
| 105 | end if |
| 106 | end if |
| 107 | |
| 108 | ! Compile patterns (for all modes - regex uses NFA/PCRE, fixed uses Boyer-Moore) |
| 109 | call compile_patterns(patterns, opts, compiled, ierr) |
| 110 | if (ierr /= 0) then |
| 111 | write(error_unit, '(A)') 'ferp: Invalid regular expression' |
| 112 | call c_exit(2_c_int) |
| 113 | end if |
| 114 | |
| 115 | any_match = .false. |
| 116 | found_early = .false. |
| 117 | |
| 118 | ! Process input sources |
| 119 | if (size(files) == 0) then |
| 120 | ! No files specified - read from stdin |
| 121 | opts%reading_stdin = .true. |
| 122 | if (src%open('-', null_data=opts%null_data)) then |
| 123 | src%filename = opts%label ! Use --label if provided |
| 124 | any_match = process_source(src, patterns, opts, compiled) |
| 125 | call src%close() |
| 126 | end if |
| 127 | else |
| 128 | ! Process each file with OpenMP parallelization (release builds) |
| 129 | ! Thread-safe: all buffers are now dynamically allocated per-thread |
| 130 | !$omp parallel do default(shared) private(src, file_match) & |
| 131 | !$omp& reduction(.or.:any_match) schedule(dynamic) |
| 132 | do i = 1, size(files) |
| 133 | ! Early termination check for quiet mode |
| 134 | if (opts%quiet .and. found_early) cycle |
| 135 | |
| 136 | ! Check for directory and handle according to dir_action |
| 137 | if (.not. opts%recursive .and. is_directory(trim(files(i)))) then |
| 138 | select case (opts%dir_action) |
| 139 | case (DIR_SKIP) |
| 140 | cycle ! Skip directories silently |
| 141 | case (DIR_RECURSE) |
| 142 | ! Note: In parallel mode, we can't modify opts |
| 143 | ! This path is rare - usually -r is specified explicitly |
| 144 | cycle |
| 145 | case default ! DIR_READ |
| 146 | ! Will try to read directory as file (usually fails) |
| 147 | end select |
| 148 | end if |
| 149 | |
| 150 | ! Check include patterns from file |
| 151 | if (num_include_patterns > 0) then |
| 152 | if (.not. matches_any_pattern(trim(files(i)), include_patterns, num_include_patterns)) then |
| 153 | cycle |
| 154 | end if |
| 155 | end if |
| 156 | |
| 157 | ! Check exclude patterns from file |
| 158 | if (num_exclude_patterns > 0) then |
| 159 | if (matches_any_pattern(trim(files(i)), exclude_patterns, num_exclude_patterns)) then |
| 160 | cycle |
| 161 | end if |
| 162 | end if |
| 163 | |
| 164 | ! Check for binary file BEFORE opening |
| 165 | if (.not. opts%text_mode) then |
| 166 | src%is_binary = check_binary_file(trim(files(i))) |
| 167 | if (src%is_binary .and. opts%ignore_binary) cycle |
| 168 | else |
| 169 | src%is_binary = .false. |
| 170 | end if |
| 171 | |
| 172 | if (src%open(trim(files(i)), opts%no_messages, opts%null_data)) then |
| 173 | ! Critical section for output serialization (prevents interleaved output) |
| 174 | !$omp critical(output_lock) |
| 175 | file_match = process_source(src, patterns, opts, compiled) |
| 176 | !$omp end critical(output_lock) |
| 177 | if (file_match) then |
| 178 | any_match = .true. |
| 179 | ! Signal early termination for quiet mode |
| 180 | if (opts%quiet) found_early = .true. |
| 181 | end if |
| 182 | call src%close() |
| 183 | end if |
| 184 | end do |
| 185 | !$omp end parallel do |
| 186 | end if |
| 187 | |
| 188 | ! Clean up compiled patterns |
| 189 | call free_patterns(compiled) |
| 190 | |
| 191 | ! Exit with appropriate code |
| 192 | ! 0 = match found, 1 = no match, 2 = error |
| 193 | if (any_match) then |
| 194 | call c_exit(0_c_int) |
| 195 | else |
| 196 | call c_exit(1_c_int) |
| 197 | end if |
| 198 | |
| 199 | contains |
| 200 | |
| 201 | subroutine append_file_to_list(file_list, filename) |
| 202 | !> Append a file to an allocatable file list |
| 203 | character(len=max_path_len), allocatable, intent(inout) :: file_list(:) |
| 204 | character(len=*), intent(in) :: filename |
| 205 | |
| 206 | character(len=max_path_len), allocatable :: temp(:) |
| 207 | integer :: n |
| 208 | |
| 209 | n = size(file_list) |
| 210 | allocate(temp(n + 1)) |
| 211 | if (n > 0) temp(1:n) = file_list |
| 212 | temp(n + 1) = filename |
| 213 | call move_alloc(temp, file_list) |
| 214 | end subroutine append_file_to_list |
| 215 | |
| 216 | end program ferp |
| 217 |