Commit | Line | Data |
760ac839 |
1 | package OS2::PrfDB; |
2 | |
3 | use strict; |
760ac839 |
4 | |
5 | require Exporter; |
5c728af0 |
6 | use XSLoader; |
7 | use Tie::Hash; |
760ac839 |
8 | |
5c728af0 |
9 | our $debug; |
10 | our @ISA = qw(Exporter Tie::Hash); |
760ac839 |
11 | # Items to export into callers namespace by default. Note: do not export |
12 | # names by default without a very good reason. Use EXPORT_OK instead. |
13 | # Do not simply export all your public functions/methods/constants. |
5c728af0 |
14 | our @EXPORT = qw( |
15 | AnyIni UserIni SystemIni |
16 | ); |
17 | our $VERSION = '0.03'; |
760ac839 |
18 | |
5c728af0 |
19 | XSLoader::load 'OS2::PrfDB', $VERSION; |
760ac839 |
20 | |
21 | # Preloaded methods go here. |
22 | |
23 | sub AnyIni { |
24 | new_from_int OS2::PrfDB::Hini OS2::Prf::System(0), |
25 | 'Anyone of two "systemish" databases', 1; |
26 | } |
27 | |
28 | sub UserIni { |
29 | new_from_int OS2::PrfDB::Hini OS2::Prf::System(1), 'User settings database', 1; |
30 | } |
31 | |
32 | sub SystemIni { |
33 | new_from_int OS2::PrfDB::Hini OS2::Prf::System(2),'System settings database',1; |
34 | } |
35 | |
760ac839 |
36 | # Internal structure 0 => HINI, 1 => array of entries, 2 => iterator. |
37 | |
38 | sub TIEHASH { |
39 | die "Usage: tie %arr, OS2::PrfDB, filename\n" unless @_ == 2; |
40 | my ($obj, $file) = @_; |
41 | my $hini = ref $file eq 'OS2::PrfDB::Hini' ? $file |
42 | : new OS2::PrfDB::Hini $file; |
43 | die "Error opening profile database `$file': $!" unless $hini; |
44 | # print "tiehash `@_', hini $hini\n" if $debug; |
45 | bless [$hini, undef, undef]; |
46 | } |
47 | |
48 | sub STORE { |
49 | my ($self, $key, $val) = @_; |
50 | die unless @_ == 3; |
51 | die unless ref $val eq 'HASH'; |
52 | my %sub; |
53 | tie %sub, 'OS2::PrfDB::Sub', $self->[0], $key; |
54 | %sub = %$val; |
55 | } |
56 | |
57 | sub FETCH { |
58 | my ($self, $key) = @_; |
59 | die unless @_ == 2; |
60 | my %sub; |
61 | tie %sub, 'OS2::PrfDB::Sub', $self->[0], $key; |
62 | \%sub; |
63 | } |
64 | |
65 | sub DELETE { |
66 | my ($self, $key) = @_; |
67 | die unless @_ == 2; |
68 | my %sub; |
69 | tie %sub, 'OS2::PrfDB::Sub', $self->[0], $key; |
70 | %sub = (); |
71 | } |
72 | |
73 | # CLEAR ???? - deletion of the whole |
74 | |
75 | sub EXISTS { |
76 | my ($self, $key) = @_; |
77 | die unless @_ == 2; |
78 | return OS2::Prf::GetLength($self->[0]->[0], $key, undef) >= 0; |
79 | } |
80 | |
81 | sub FIRSTKEY { |
82 | my $self = shift; |
83 | my $keys = OS2::Prf::Get($self->[0]->[0], undef, undef); |
84 | return undef unless defined $keys; |
85 | chop($keys); |
86 | $self->[1] = [split /\0/, $keys]; |
87 | # print "firstkey1 $self, `$self->[3]->[0], $self->[3]->[1]'\n" if $debug; |
88 | $self->[2] = 0; |
89 | return $self->[1]->[0]; |
90 | # OS2::Prf::Get($self->[0]->[0], $self->[2], $self->[3]->[0])); |
91 | } |
92 | |
93 | sub NEXTKEY { |
94 | # print "nextkey `@_'\n" if $debug; |
95 | my $self = shift; |
96 | return undef unless $self->[2]++ < $#{$self->[1]}; |
97 | my $key = $self->[1]->[$self->[2]]; |
98 | return $key; #, OS2::Prf::Get($self->[0]->[0], $self->[2], $key)); |
99 | } |
100 | |
101 | package OS2::PrfDB::Hini; |
102 | |
103 | sub new { |
104 | die "Usage: new OS2::PrfDB::Hini filename\n" unless @_ == 2; |
105 | shift; |
106 | my $file = shift; |
107 | my $hini = OS2::Prf::Open($file); |
108 | die "Error opening profile database `$file': $!" unless $hini; |
109 | bless [$hini, $file]; |
110 | } |
111 | |
112 | # Takes HINI and file name: |
113 | |
114 | sub new_from_int { shift; bless [@_] } |
115 | |
116 | # Internal structure 0 => HINI, 1 => filename, 2 => do-not-close. |
117 | |
118 | sub DESTROY { |
119 | my $self = shift; |
120 | my $hini = $self->[0]; |
121 | unless ($self->[2]) { |
122 | OS2::Prf::Close($hini) or die "Error closing profile `$self->[1]': $!"; |
123 | } |
124 | } |
125 | |
126 | package OS2::PrfDB::Sub; |
760ac839 |
127 | use Tie::Hash; |
5c728af0 |
128 | |
129 | our $debug; |
130 | our @ISA = qw{Tie::Hash}; |
760ac839 |
131 | |
132 | # Internal structure 0 => HINI, 1 => array of entries, 2 => iterator, |
133 | # 3 => appname. |
134 | |
135 | sub TIEHASH { |
136 | die "Usage: tie %arr, OS2::PrfDB::Sub, filename, appname\n" unless @_ == 3; |
137 | my ($obj, $file, $app) = @_; |
138 | my $hini = ref $file eq 'OS2::PrfDB::Hini' ? $file |
139 | : new OS2::PrfDB::Hini $file; |
140 | die "Error opening profile database `$file': $!" unless $hini; |
141 | # print "tiehash `@_', hini $hini\n" if $debug; |
142 | bless [$hini, undef, undef, $app]; |
143 | } |
144 | |
145 | sub STORE { |
146 | my ($self, $key, $val) = @_; |
147 | die unless @_ == 3; |
148 | OS2::Prf::Set($self->[0]->[0], $self->[3], $key, $val); |
149 | } |
150 | |
151 | sub FETCH { |
152 | my ($self, $key) = @_; |
153 | die unless @_ == 2; |
154 | OS2::Prf::Get($self->[0]->[0], $self->[3], $key); |
155 | } |
156 | |
157 | sub DELETE { |
158 | my ($self, $key) = @_; |
159 | die unless @_ == 2; |
160 | OS2::Prf::Set($self->[0]->[0], $self->[3], $key, undef); |
161 | } |
162 | |
163 | # CLEAR ???? - deletion of the whole |
164 | |
165 | sub EXISTS { |
166 | my ($self, $key) = @_; |
167 | die unless @_ == 2; |
168 | return OS2::Prf::GetLength($self->[0]->[0], $self->[3], $key) >= 0; |
169 | } |
170 | |
171 | sub FIRSTKEY { |
172 | my $self = shift; |
173 | my $keys = OS2::Prf::Get($self->[0]->[0], $self->[3], undef); |
174 | return undef unless defined $keys; |
175 | chop($keys); |
176 | $self->[1] = [split /\0/, $keys]; |
177 | # print "firstkey1 $self, `$self->[3]->[0], $self->[3]->[1]'\n" if $debug; |
178 | $self->[2] = 0; |
179 | return $self->[1]->[0]; |
180 | # OS2::Prf::Get($self->[0]->[0], $self->[2], $self->[3]->[0])); |
181 | } |
182 | |
183 | sub NEXTKEY { |
184 | # print "nextkey `@_'\n" if $debug; |
185 | my $self = shift; |
186 | return undef unless $self->[2]++ < $#{$self->[1]}; |
187 | my $key = $self->[1]->[$self->[2]]; |
188 | return $key; #, OS2::Prf::Get($self->[0]->[0], $self->[2], $key)); |
189 | } |
190 | |
191 | # Autoload methods go after =cut, and are processed by the autosplit program. |
192 | |
193 | 1; |
194 | __END__ |
195 | # Below is the stub of documentation for your module. You better edit it! |
196 | |
197 | =head1 NAME |
198 | |
199 | OS2::PrfDB - Perl extension for access to OS/2 setting database. |
200 | |
201 | =head1 SYNOPSIS |
202 | |
203 | use OS2::PrfDB; |
204 | tie %settings, OS2::PrfDB, 'my.ini'; |
205 | tie %subsettings, OS2::PrfDB::Sub, 'my.ini', 'mykey'; |
206 | |
207 | print "$settings{firstkey}{subkey}\n"; |
208 | print "$subsettings{subkey}\n"; |
209 | |
210 | tie %system, OS2::PrfDB, SystemIni; |
211 | $system{myapp}{mykey} = "myvalue"; |
212 | |
213 | |
214 | =head1 DESCRIPTION |
215 | |
216 | The extention provides both high-level and low-level access to .ini |
217 | files. |
218 | |
219 | =head2 High level access |
220 | |
221 | High-level access is the tie-hash access via two packages: |
222 | C<OS2::PrfDB> and C<OS2::PrfDB::Sub>. First one supports one argument, |
223 | the name of the file to open, the second one the name of the file to |
224 | open and so called I<Application name>, or the primary key of the |
225 | database. |
226 | |
227 | tie %settings, OS2::PrfDB, 'my.ini'; |
228 | tie %subsettings, OS2::PrfDB::Sub, 'my.ini', 'mykey'; |
229 | |
230 | One may substitute a handle for already opened ini-file instead of the |
231 | file name (obtained via low-level access functions). In particular, 3 |
232 | functions SystemIni(), UserIni(), and AnyIni() provide handles to the |
233 | "systemish" databases. AniIni will read from both, and write into User |
234 | database. |
235 | |
236 | =head2 Low-level access |
237 | |
238 | Low-level access functions reside in the package C<OS2::Prf>. They are |
239 | |
240 | =over 14 |
241 | |
242 | =item C<Open(file)> |
243 | |
244 | Opens the database, returns an I<integer handle>. |
245 | |
246 | =item C<Close(hndl)> |
247 | |
248 | Closes the database given an I<integer handle>. |
249 | |
250 | =item C<Get(hndl, appname, key)> |
251 | |
252 | Retrieves data from the database given 2-part-key C<appname> C<key>. |
253 | If C<key> is C<undef>, return the "\0" delimited list of C<key>s, |
254 | terminated by \0. If C<appname> is C<undef>, returns the list of |
255 | possible C<appname>s in the same form. |
256 | |
257 | =item C<GetLength(hndl, appname, key)> |
258 | |
259 | Same as above, but returns the length of the value. |
260 | |
261 | =item C<Set(hndl, appname, key, value [ , length ])> |
262 | |
263 | Sets the value. If the C<value> is not defined, removes the C<key>. If |
264 | the C<key> is not defined, removes the C<appname>. |
265 | |
266 | =item C<System(val)> |
267 | |
268 | Return an I<integer handle> associated with the system database. If |
269 | C<val> is 1, it is I<User> database, if 2, I<System> database, if |
270 | 0, handle for "both" of them: the handle works for read from any one, |
271 | and for write into I<User> one. |
272 | |
273 | =item C<Profiles()> |
274 | |
275 | returns a reference to a list of two strings, giving names of the |
276 | I<User> and I<System> databases. |
277 | |
278 | =item C<SetUser(file)> |
279 | |
280 | B<(Not tested.)> Sets the profile name of the I<User> database. The |
281 | application should have a message queue to use this function! |
282 | |
283 | =back |
284 | |
285 | =head2 Integer handles |
286 | |
287 | To convert a name or an integer handle into an object acceptable as |
288 | argument to tie() interface, one may use the following functions from |
289 | the package C<OS2::Prf::Hini>: |
290 | |
291 | =over 14 |
292 | |
293 | =item C<new(package, file)> |
294 | |
295 | =item C<new_from_int(package, int_hndl [ , filename ])> |
296 | |
297 | =back |
298 | |
299 | =head2 Exports |
300 | |
301 | SystemIni(), UserIni(), and AnyIni(). |
302 | |
303 | =head1 AUTHOR |
304 | |
305 | Ilya Zakharevich, ilya@math.ohio-state.edu |
306 | |
307 | =head1 SEE ALSO |
308 | |
309 | perl(1). |
310 | |
311 | =cut |
312 | |