| 1 | module regex_module |
| 2 | use iso_c_binding |
| 3 | implicit none |
| 4 | private |
| 5 | |
| 6 | public :: regex_compile, regex_match, regex_free, regex_free_all |
| 7 | public :: REG_EXTENDED, REG_ICASE, REG_NOSUB |
| 8 | |
| 9 | ! POSIX regex flags (from regex.h) |
| 10 | integer(c_int), parameter :: REG_EXTENDED = 1 ! Use Extended Regular Expressions |
| 11 | integer(c_int), parameter :: REG_ICASE = 2 ! Ignore case |
| 12 | integer(c_int), parameter :: REG_NOSUB = 4 ! Don't store match positions |
| 13 | |
| 14 | ! C function interfaces |
| 15 | interface |
| 16 | function compile_regex_c(pattern, cflags) bind(C, name="compile_regex") |
| 17 | use iso_c_binding |
| 18 | character(kind=c_char), dimension(*), intent(in) :: pattern |
| 19 | integer(c_int), value :: cflags |
| 20 | integer(c_int) :: compile_regex_c |
| 21 | end function compile_regex_c |
| 22 | |
| 23 | function match_regex_c(id, text, match_start, match_len) bind(C, name="match_regex") |
| 24 | use iso_c_binding |
| 25 | integer(c_int), value :: id |
| 26 | character(kind=c_char), dimension(*), intent(in) :: text |
| 27 | integer(c_int), intent(out) :: match_start |
| 28 | integer(c_int), intent(out) :: match_len |
| 29 | integer(c_int) :: match_regex_c |
| 30 | end function match_regex_c |
| 31 | |
| 32 | subroutine free_regex_c(id) bind(C, name="free_regex") |
| 33 | use iso_c_binding |
| 34 | integer(c_int), value :: id |
| 35 | end subroutine free_regex_c |
| 36 | |
| 37 | subroutine free_all_regex_c() bind(C, name="free_all_regex") |
| 38 | use iso_c_binding |
| 39 | end subroutine free_all_regex_c |
| 40 | end interface |
| 41 | |
| 42 | contains |
| 43 | |
| 44 | ! Compile a regex pattern |
| 45 | ! Returns regex ID (>= 0) on success, -1 on error |
| 46 | function regex_compile(pattern, case_sensitive) result(regex_id) |
| 47 | character(len=*), intent(in) :: pattern |
| 48 | logical, intent(in) :: case_sensitive |
| 49 | integer :: regex_id |
| 50 | integer(c_int) :: cflags |
| 51 | character(len=len_trim(pattern)+1, kind=c_char) :: c_pattern |
| 52 | |
| 53 | ! Set flags |
| 54 | cflags = REG_EXTENDED |
| 55 | if (.not. case_sensitive) then |
| 56 | cflags = cflags + REG_ICASE |
| 57 | end if |
| 58 | |
| 59 | ! Convert Fortran string to C string (null-terminated) |
| 60 | c_pattern = trim(pattern) // c_null_char |
| 61 | |
| 62 | ! Call C function |
| 63 | regex_id = compile_regex_c(c_pattern, cflags) |
| 64 | end function regex_compile |
| 65 | |
| 66 | ! Match a regex against text |
| 67 | ! Returns .true. if match found, .false. otherwise |
| 68 | ! match_start and match_len are 1-based indices (Fortran style) |
| 69 | function regex_match(regex_id, text, match_start, match_len) result(found) |
| 70 | integer, intent(in) :: regex_id |
| 71 | character(len=*), intent(in) :: text |
| 72 | integer, intent(out) :: match_start, match_len |
| 73 | logical :: found |
| 74 | integer(c_int) :: result, c_start, c_len |
| 75 | character(len=len(text)+1, kind=c_char) :: c_text |
| 76 | |
| 77 | ! Convert Fortran string to C string |
| 78 | c_text = text // c_null_char |
| 79 | |
| 80 | ! Call C function |
| 81 | result = match_regex_c(regex_id, c_text, c_start, c_len) |
| 82 | |
| 83 | if (result == 1) then |
| 84 | ! Match found - convert C indices (0-based) to Fortran (1-based) |
| 85 | match_start = c_start + 1 |
| 86 | match_len = c_len |
| 87 | found = .true. |
| 88 | else |
| 89 | match_start = 0 |
| 90 | match_len = 0 |
| 91 | found = .false. |
| 92 | end if |
| 93 | end function regex_match |
| 94 | |
| 95 | ! Free a compiled regex |
| 96 | subroutine regex_free(regex_id) |
| 97 | integer, intent(in) :: regex_id |
| 98 | call free_regex_c(regex_id) |
| 99 | end subroutine regex_free |
| 100 | |
| 101 | ! Free all compiled regexes |
| 102 | subroutine regex_free_all() |
| 103 | call free_all_regex_c() |
| 104 | end subroutine regex_free_all |
| 105 | |
| 106 | end module regex_module |
| 107 |