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! =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 and C. 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, 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. They are =over 14 =item C Opens the database, returns an I. =item C Closes the database given an I. =item C Retrieves data from the database given 2-part-key C C. If C is C, return the "\0" delimited list of Cs, terminated by \0. If C is C, returns the list of possible Cs in the same form. =item C Same as above, but returns the length of the value. =item C Sets the value. If the C is not defined, removes the C. If the C is not defined, removes the C. =item C Return an I associated with the system database. If C is 1, it is I database, if 2, I database, if 0, handle for "both" of them: the handle works for read from any one, and for write into I one. =item C returns a reference to a list of two strings, giving names of the I and I databases. =item C B<(Not tested.)> Sets the profile name of the I 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: =over 14 =item C =item C =back =head2 Exports SystemIni(), UserIni(), and AnyIni(). =head1 AUTHOR Ilya Zakharevich, ilya@math.ohio-state.edu =head1 SEE ALSO perl(1). =cut