os2/OS2/PrfDB/PrfDB.pm

   1 package OS2::PrfDB;
   2
   3 use strict;
   4
   5 require Exporter;
   6 use XSLoader;
   7 use Tie::Hash;
   8
   9 our $debug;
  10 our @ISA = qw(Exporter Tie::Hash);
  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.
  14 our @EXPORT = qw(
  15                  AnyIni UserIni SystemIni
  16                 );
  17 our $VERSION = '0.04';
  18
  19 XSLoader::load 'OS2::PrfDB', $VERSION;
  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
  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;
 127 use Tie::Hash;
 128
 129 our $debug;
 130 our @ISA = qw{Tie::Hash};
 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 extension 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