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