—

              
package OS2::PrfDB;
use strict;
require Exporter;
use XSLoader;
use Tie::Hash;
our $debug;
our @ISA = qw(Exporter Tie::Hash);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
our @EXPORT = qw(
                 AnyIni UserIni SystemIni
                );
our $VERSION = '0.04';
XSLoader::load 'OS2::PrfDB', $VERSION;
# Preloaded methods go here.
sub AnyIni {
  new_from_int OS2::PrfDB::Hini OS2::Prf::System(0), 
  'Anyone of two "systemish" databases', 1;
}
sub UserIni {
  new_from_int OS2::PrfDB::Hini OS2::Prf::System(1), 'User settings database', 1;
}
sub SystemIni {
  new_from_int OS2::PrfDB::Hini OS2::Prf::System(2),'System settings database',1;
}
# Internal structure 0 => HINI, 1 => array of entries, 2 => iterator.
sub TIEHASH {
  die "Usage: tie %arr, OS2::PrfDB, filename\n" unless @_ == 2;
  my ($obj, $file) = @_;
  my $hini = ref $file eq 'OS2::PrfDB::Hini' ? $file 
                                             : new OS2::PrfDB::Hini $file;
  die "Error opening profile database `$file': $!" unless $hini;
  # print "tiehash `@_', hini $hini\n" if $debug;
  bless [$hini, undef, undef];
}
sub STORE {
  my ($self, $key, $val) = @_;
  die unless @_ == 3;
  die unless ref $val eq 'HASH';
  my %sub;
  tie %sub, 'OS2::PrfDB::Sub', $self->[0], $key;
  %sub = %$val;
}
sub FETCH {
  my ($self, $key) = @_;
  die unless @_ == 2;
  my %sub;
  tie %sub, 'OS2::PrfDB::Sub', $self->[0], $key;
  \%sub;
}
sub DELETE {
  my ($self, $key) = @_;
  die unless @_ == 2;
  my %sub;
  tie %sub, 'OS2::PrfDB::Sub', $self->[0], $key;
  %sub = ();
}
# CLEAR ???? - deletion of the whole
sub EXISTS {
  my ($self, $key) = @_;
  die unless @_ == 2;
  return OS2::Prf::GetLength($self->[0]->[0], $key, undef) >= 0;
}
sub FIRSTKEY {
  my $self = shift;
  my $keys = OS2::Prf::Get($self->[0]->[0], undef, undef);
  return undef unless defined $keys;
  chop($keys);
  $self->[1] = [split /\0/, $keys];
  # print "firstkey1 $self, `$self->[3]->[0], $self->[3]->[1]'\n" if $debug;
  $self->[2] = 0;
  return $self->[1]->[0];
          # OS2::Prf::Get($self->[0]->[0], $self->[2], $self->[3]->[0]));
}
sub NEXTKEY {
  # print "nextkey `@_'\n" if $debug;
  my $self = shift;
  return undef unless $self->[2]++ < $#{$self->[1]};
  my $key = $self->[1]->[$self->[2]];
  return $key; #, OS2::Prf::Get($self->[0]->[0], $self->[2], $key));
}
package OS2::PrfDB::Hini;
sub new {
  die "Usage: new OS2::PrfDB::Hini filename\n" unless @_ == 2;
  shift;
  my $file = shift;
  my $hini = OS2::Prf::Open($file);
  die "Error opening profile database `$file': $!" unless $hini;
  bless [$hini, $file];
}
# Takes HINI and file name:
sub new_from_int { shift; bless [@_] }
# Internal structure 0 => HINI, 1 => filename, 2 => do-not-close.
sub DESTROY {
  my $self = shift; 
  my $hini = $self->[0];
  unless ($self->[2]) {
    OS2::Prf::Close($hini) or die "Error closing profile `$self->[1]': $!";
  }
}
package OS2::PrfDB::Sub;
use Tie::Hash;
our $debug;
our @ISA = qw{Tie::Hash};
# Internal structure 0 => HINI, 1 => array of entries, 2 => iterator,
# 3 => appname.
sub TIEHASH {
  die "Usage: tie %arr, OS2::PrfDB::Sub, filename, appname\n" unless @_ == 3;
  my ($obj, $file, $app) = @_;
  my $hini = ref $file eq 'OS2::PrfDB::Hini' ? $file 
                                             : new OS2::PrfDB::Hini $file;
  die "Error opening profile database `$file': $!" unless $hini;
  # print "tiehash `@_', hini $hini\n" if $debug;
  bless [$hini, undef, undef, $app];
}
sub STORE {
  my ($self, $key, $val) = @_;
  die unless @_ == 3;
  OS2::Prf::Set($self->[0]->[0], $self->[3], $key, $val);
}
sub FETCH {
  my ($self, $key) = @_;
  die unless @_ == 2;
  OS2::Prf::Get($self->[0]->[0], $self->[3], $key);
}
sub DELETE {
  my ($self, $key) = @_;
  die unless @_ == 2;
  OS2::Prf::Set($self->[0]->[0], $self->[3], $key, undef);
}
# CLEAR ???? - deletion of the whole
sub EXISTS {
  my ($self, $key) = @_;
  die unless @_ == 2;
  return OS2::Prf::GetLength($self->[0]->[0], $self->[3], $key) >= 0;
}
sub FIRSTKEY {
  my $self = shift;
  my $keys = OS2::Prf::Get($self->[0]->[0], $self->[3], undef);
  return undef unless defined $keys;
  chop($keys);
  $self->[1] = [split /\0/, $keys];
  # print "firstkey1 $self, `$self->[3]->[0], $self->[3]->[1]'\n" if $debug;
  $self->[2] = 0;
  return $self->[1]->[0];
          # OS2::Prf::Get($self->[0]->[0], $self->[2], $self->[3]->[0]));
}
sub NEXTKEY {
  # print "nextkey `@_'\n" if $debug;
  my $self = shift;
  return undef unless $self->[2]++ < $#{$self->[1]};
  my $key = $self->[1]->[$self->[2]];
  return $key; #, OS2::Prf::Get($self->[0]->[0], $self->[2], $key));
}
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
__END__
# Below is the stub of documentation for your module. You better edit it!
HideShow 116 lines of Pod
=head1 NAME
OS2::PrfDB - Perl extension for access to OS/2 setting database.
=head1 SYNOPSIS
  use OS2::PrfDB;
  tie %settings, OS2::PrfDB, 'my.ini';
  tie %subsettings, OS2::PrfDB::Sub, 'my.ini', 'mykey';
  print "$settings{firstkey}{subkey}\n";
  print "$subsettings{subkey}\n";
  tie %system, OS2::PrfDB, SystemIni;
  $system{myapp}{mykey} = "myvalue";
=head1 DESCRIPTION
The extension provides both high-level and low-level access to .ini
files. 
=head2 High level access
High-level access is the tie-hash access via two packages:
C<OS2::PrfDB> and C<OS2::PrfDB::Sub>. First one supports one argument,
the name of the file to open, the second one the name of the file to
open and so called I<Application name>, or the primary key of the
database.
  tie %settings, OS2::PrfDB, 'my.ini';
  tie %subsettings, OS2::PrfDB::Sub, 'my.ini', 'mykey';
One may substitute a handle for already opened ini-file instead of the
file name (obtained via low-level access functions). In particular, 3
functions SystemIni(), UserIni(), and AnyIni() provide handles to the
"systemish" databases. AniIni will read from both, and write into User
database.
=head2 Low-level access
Low-level access functions reside in the package C<OS2::Prf>. They are
=over 14
=item C<Open(file)>
Opens the database, returns an I<integer handle>.
=item C<Close(hndl)>
Closes the database given an I<integer handle>.
=item C<Get(hndl, appname, key)>
Retrieves data from the database given 2-part-key C<appname> C<key>.
If C<key> is C<undef>, return the "\0" delimited list of C<key>s,
terminated by \0. If C<appname> is C<undef>, returns the list of
possible C<appname>s in the same form.
=item C<GetLength(hndl, appname, key)>
Same as above, but returns the length of the value.
=item C<Set(hndl, appname, key, value [ , length ])>
Sets the value. If the C<value> is not defined, removes the C<key>. If
the C<key> is not defined, removes the C<appname>.
=item C<System(val)>
Return an I<integer handle> associated with the system database. If
C<val> is 1, it is I<User> database, if 2, I<System> database, if
0, handle for "both" of them: the handle works for read from any one,
and for write into I<User> one.
=item C<Profiles()>
returns a reference to a list of two strings, giving names of the
I<User> and I<System> databases.
=item C<SetUser(file)>
B<(Not tested.)> Sets the profile name of the I<User> database. The
application should have a message queue to use this function!
=back
=head2 Integer handles
To convert a name or an integer handle into an object acceptable as
argument to tie() interface, one may use the following functions from
the package C<OS2::Prf::Hini>:
=over 14
=item C<new(package, file)>
=item C<new_from_int(package, int_hndl [ , filename ])>
=back
=head2 Exports
SystemIni(), UserIni(), and AnyIni().
=head1 AUTHOR
Ilya Zakharevich, ilya@math.ohio-state.edu
=head1 SEE ALSO
perl(1).
=cut