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 | |
---|