File: dbf\filenames.adb
1 --::::::::::
2 --filename.adb
3 --::::::::::
4 -- Developed by (C) Wasiliy W. Molostoff 1994, 1995.
5 -- Moscow, Russia,
6 -- Voice: 7 (095) 398-23-38
7 -- e-mail: edv@edv.msk.ru
8 -- This is free software; you can freely redistribute it and/or
9 -- modify it without any restrictions. Please report any errors.
10 -- All corrections will be made as soon as possible.
11 with text_io;
12 package body filenames is
13
14 type septype is (volume, pathlist, typemark, version, namechar);
15
16 function sep (c: character) return septype is
17 begin
18 case c is
19 when '.' => return typemark;
20 when '\' | '/' |
21 '[' | ']' => return pathlist;
22 when ':' => return volume;
23 when ';' => return version;
24 when others => return namechar;
25 end case;
26 end;
27
28 ------------------------------------------------------------------------
29
30 function volumename (name: in string) return string is
31 begin
32 for n in name'range
33 loop
34 case sep(name (n)) is
35 when volume => return name (name'first..n);
36 when namechar => null;
37 when others => exit;
38 end case;
39 end loop;
40 return "";
41 end;
42
43 ------------------------------------------------------------------------
44
45 function pathname (name: in string) return string is
46 p_beg: positive := name'first + volumename (name)'length;
47 p_end: natural := 0;
48 begin
49 for n in p_beg..name'last
50 loop
51 case sep(name (n)) is
52 when pathlist => p_end := n;
53 when others => null;
54 end case;
55 end loop;
56
57 if p_beg <= p_end
58 then
59 return name (p_beg..p_end);
60 end if;
61 return "";
62 end;
63
64 ------------------------------------------------------------------------
65
66 function filename (name: in string) return string is
67 f_end: natural := name'last;
68 f_beg: natural := name'first;
69 begin
70 for n in reverse name'range
71 loop
72 case sep(name (n)) is
73 when typemark |
74 version => f_end := n - 1;
75 when namechar => null;
76 when others => f_beg := n + 1;
77 exit;
78 end case;
79 end loop;
80 return name (f_beg..f_end);
81 end;
82
83 ------------------------------------------------------------------------
84
85 function typename (name: in string) return string is
86 t_end: natural := name'last;
87 begin
88 for n in reverse name'range
89 loop
90 case sep(name (n)) is
91 when typemark => return name (n..t_end);
92 when version => t_end := n - 1;
93 when namechar => null;
94 when others => exit;
95 end case;
96 end loop;
97 return "";
98 end;
99
100 ------------------------------------------------------------------------
101
102 function fullname (name: in string) return string is
103 use text_io;
104 file: file_type;
105
106 function checked (s: in string) return string is
107 tmp: string (name'range);
108 begin
109 for n in tmp'range
110 loop
111 case s(n) is
112 when '\' => tmp (n) := '/';
113 when others => tmp (n) := s(n);
114 end case;
115 end loop;
116 return tmp;
117 end;
118
119 function name_then_close (n: string) return string is
120 begin
121 close (file); return (n);
122 end;
123
124 begin
125 if name'length > 0
126 then
127 begin
128 open (file, name => checked (name), mode => in_file);
129 return name_then_close (text_io.name (file));
130 exception
131 when others => null;
132 end;
133
134 end if;
135 return name;
136 end;
137
138 function existent (name: in string) return boolean is
139 use text_io;
140 file: file_type;
141
142 begin
143 if name'length > 0
144 then begin
145 open (file, name => name, mode => in_file);
146 close (file); return true;
147 exception
148 when others => null;
149 end;
150
151 begin
152 open (file, name => name, mode => out_file);
153 close (file); return true;
154 exception
155 when others => null;
156 end;
157 end if;
158 return false;
159 end;
160
161 end;
162