[6] | 1 | program m |
---|
| 2 | |
---|
| 3 | character(len=100) :: p, t |
---|
| 4 | logical :: result |
---|
| 5 | |
---|
| 6 | do |
---|
| 7 | write(unit=*,fmt="(a)",advance="no") "Target path: " |
---|
| 8 | read(unit=*,fmt="(a)") t |
---|
| 9 | write(unit=*,fmt="(a)",advance="no") "Path: " |
---|
| 10 | read(unit=*,fmt="(a)") p |
---|
| 11 | |
---|
| 12 | result = match(p,t) |
---|
| 13 | print *, "Result: ", result |
---|
| 14 | |
---|
| 15 | enddo |
---|
| 16 | |
---|
| 17 | |
---|
| 18 | CONTAINS |
---|
| 19 | |
---|
| 20 | recursive function match(p,ptarget) result(res_match) |
---|
| 21 | character(len=*), intent(in) :: p |
---|
| 22 | character(len=*), intent(in) :: ptarget |
---|
| 23 | logical :: res_match |
---|
| 24 | |
---|
| 25 | ! |
---|
| 26 | ! Checks whether a given XML path matches the target path ptarget |
---|
| 27 | ! Only absolute paths are considered. |
---|
| 28 | ! |
---|
| 29 | ! Examples of target paths: |
---|
| 30 | ! |
---|
| 31 | ! /pseudo/vps/radfunc [1] |
---|
| 32 | ! //radfunc/data |
---|
| 33 | ! //data |
---|
| 34 | ! //*/vps/data |
---|
| 35 | ! //job//data |
---|
| 36 | ! //* |
---|
| 37 | ! |
---|
| 38 | integer :: len_target, len_path, pos_target, pos_path |
---|
| 39 | character(len=100) :: anchor_leaf |
---|
| 40 | |
---|
| 41 | res_match = .false. |
---|
| 42 | |
---|
| 43 | print *, ":testing: " |
---|
| 44 | print *, " ", trim(p) |
---|
| 45 | print *, " against: ", trim(ptarget) |
---|
| 46 | print *, "-----------------------------------------" |
---|
| 47 | |
---|
| 48 | if (trim(p) == trim(ptarget)) then |
---|
| 49 | res_match = .true. |
---|
| 50 | print *, "outright equality" |
---|
| 51 | return |
---|
| 52 | |
---|
| 53 | else if (ptarget == "/") then |
---|
| 54 | ! We process // in the middle below |
---|
| 55 | |
---|
| 56 | res_match = .true. |
---|
| 57 | print *, "target begins by //" |
---|
| 58 | return |
---|
| 59 | |
---|
| 60 | else ! We get the extreme elements |
---|
| 61 | |
---|
| 62 | len_target = len_trim(ptarget) |
---|
| 63 | len_path = len_trim(p) |
---|
| 64 | pos_target = index(ptarget,"/",back=.true.) |
---|
| 65 | pos_path = index(p,"/",back=.true.) |
---|
| 66 | |
---|
| 67 | print *, " Path leaf: ", p(pos_path+1:len_path) |
---|
| 68 | print *, " Target leaf: ", ptarget(pos_target+1:len_target) |
---|
| 69 | |
---|
| 70 | if (pos_target == len_target) then ! // in the middle... |
---|
| 71 | ! Get leaf further up |
---|
| 72 | search_anchor : do |
---|
| 73 | print *, "looking for anchor in: ", ptarget(1:len_target-1) |
---|
| 74 | print *, "press enter" |
---|
| 75 | read * |
---|
| 76 | pos_target = index(ptarget(1:len_target-1),"/",back=.true.) |
---|
| 77 | print *, "pos_target in anchor search: ", pos_target |
---|
| 78 | if (pos_target == 1) then ! Target begins by /.// |
---|
| 79 | res_match = .true. |
---|
| 80 | print *, "reached initial /.// in target" |
---|
| 81 | return |
---|
| 82 | endif |
---|
| 83 | anchor_leaf = ptarget(pos_target:len_target-1) |
---|
| 84 | print *, " Anchor leaf: ", trim(anchor_leaf) |
---|
| 85 | if (anchor_leaf == "/.") then ! keep searching |
---|
| 86 | len_target = pos_target |
---|
| 87 | cycle search_anchor |
---|
| 88 | else |
---|
| 89 | exit search_anchor |
---|
| 90 | endif |
---|
| 91 | enddo search_anchor |
---|
| 92 | |
---|
| 93 | ! Note that the anchor includes the leading / |
---|
| 94 | ! Now we search for that anchor in the candidate path |
---|
| 95 | ! |
---|
| 96 | print *, " Searching anchor in : ", trim(p(1:len_path)) |
---|
| 97 | pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.) |
---|
| 98 | if (pos_path /= 0) then |
---|
| 99 | |
---|
| 100 | ! Found anchor. Continue further up. |
---|
| 101 | ! |
---|
| 102 | res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1)) |
---|
| 103 | endif |
---|
| 104 | |
---|
| 105 | else if (ptarget(pos_target+1:len_target) == ".") then |
---|
| 106 | |
---|
| 107 | ! A dot is a dummy. Continue further up. |
---|
| 108 | ! |
---|
| 109 | res_match = match(p(1:len_path),ptarget(1:pos_target-1)) |
---|
| 110 | |
---|
| 111 | else if (ptarget(pos_target+1:len_target) == "*") then |
---|
| 112 | |
---|
| 113 | if (len_path == pos_path) then |
---|
| 114 | print *, "empty element. len_path, pos_path: ", len_path, pos_path |
---|
| 115 | RETURN ! empty path element |
---|
| 116 | endif |
---|
| 117 | |
---|
| 118 | ! A star matches any non-empty leaf. Continue further up. |
---|
| 119 | ! |
---|
| 120 | res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1)) |
---|
| 121 | |
---|
| 122 | else if (p(pos_path+1:len_path) == & |
---|
| 123 | ptarget(pos_target+1:len_target)) then |
---|
| 124 | |
---|
| 125 | ! Leafs are equal. Continue further up. |
---|
| 126 | ! |
---|
| 127 | res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1)) |
---|
| 128 | |
---|
| 129 | endif |
---|
| 130 | |
---|
| 131 | endif |
---|
| 132 | |
---|
| 133 | end function match |
---|
| 134 | |
---|
| 135 | end program m |
---|
| 136 | |
---|
| 137 | |
---|
| 138 | |
---|
| 139 | |
---|
| 140 | |
---|
| 141 | |
---|
| 142 | |
---|
| 143 | |
---|
| 144 | |
---|
| 145 | |
---|
| 146 | |
---|
| 147 | |
---|
| 148 | |
---|