source: XMLF90/src/xpath/match_tester.f90

Last change on this file was 6, checked in by ymipsl, 13 years ago

Import des sources XMLF90

File size: 3.6 KB
Line 
1program m
2
3character(len=100) :: p, t
4logical            :: result
5
6do
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
15enddo
16
17
18CONTAINS
19
20recursive function match(p,ptarget) result(res_match)
21character(len=*), intent(in)  :: p
22character(len=*), intent(in)  :: ptarget
23logical                       :: 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!
38integer  :: len_target, len_path, pos_target, pos_path
39character(len=100)   :: anchor_leaf
40
41res_match = .false.       
42
43 print *, ":testing: "
44 print *, "          ", trim(p)
45 print *, " against: ", trim(ptarget)
46 print *, "-----------------------------------------"
47
48if (trim(p) == trim(ptarget)) then
49   res_match = .true.
50   print *, "outright equality"
51   return
52
53else if (ptarget == "/") then
54   ! We  process // in the middle below
55
56   res_match = .true.
57   print *, "target begins by //"
58   return
59
60else              ! 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
131endif
132
133end function match
134
135end program m
136
137
138
139
140
141
142
143
144
145
146
147
148
Note: See TracBrowser for help on using the repository browser.