dslinux/user/perl/os2/OS2/PrfDB Changes MANIFEST Makefile.PL PrfDB.pm PrfDB.xs

[cayenne]

Update of /cvsroot/dslinux/dslinux/user/perl/os2/OS2/PrfDB
In directory antilope:/tmp/cvs-serv17422/os2/OS2/PrfDB

Added Files:
	Changes MANIFEST Makefile.PL PrfDB.pm PrfDB.xs 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: PrfDB.pm ---
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<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 at math.ohio-state.edu

=head1 SEE ALSO

perl(1).

=cut


--- NEW FILE: MANIFEST ---
Changes
MANIFEST
Makefile.PL
PrfDB.pm
PrfDB.xs
t/os2_prfdb.t
typemap

--- NEW FILE: Changes ---
Revision history for Perl extension OS2::PrfDB.

0.01  Tue Mar 26 19:35:27 1996
	- original version; created by h2xs 1.16
0.02:  Field do-not-close added to OS2::Prf::Hini.
0.03:  Update to XSLoader and 'our'.

--- NEW FILE: Makefile.PL ---
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
    'NAME'	=> 'OS2::PrfDB',
    'VERSION_FROM' => 'PrfDB.pm', # finds $VERSION
    MAN3PODS 	=> {}, 	# Pods will be built by installman.
    'LIBS'	=> [''],   # e.g., '-lm' 
    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
    'INC'	=> '',     # e.g., '-I/usr/include/other' 
);

--- NEW FILE: PrfDB.xs ---
#define INCL_WINSHELLDATA /* Or use INCL_WIN, INCL_PM, */

#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <os2.h>
#ifdef __cplusplus
}
#endif

#define Prf_Open(pszFileName) SaveWinError(pPrfOpenProfile(Perl_hab, (pszFileName)))
#define Prf_Close(hini) (!CheckWinError(pPrfCloseProfile(hini)))

BOOL (*pPrfCloseProfile) (HINI hini);
HINI (*pPrfOpenProfile) (HAB hab, PCSZ pszFileName);
BOOL (*pPrfQueryProfile) (HAB hab, PPRFPROFILE pPrfProfile);
BOOL (*pPrfQueryProfileData) (HINI hini, PCSZ pszApp, PCSZ pszKey, PVOID pBuffer,
    PULONG pulBufferLength);
/*
LONG (*pPrfQueryProfileInt) (HINI hini, PCSZ pszApp, PCSZ pszKey, LONG  sDefault);
 */
BOOL (*pPrfQueryProfileSize) (HINI hini, PCSZ pszApp, PCSZ pszKey,
    PULONG pulReqLen);
/*
ULONG (*pPrfQueryProfileString) (HINI hini, PCSZ pszApp, PCSZ pszKey,
    PCSZ pszDefault, PVOID pBuffer, ULONG ulBufferLength);
 */
BOOL (*pPrfReset) (HAB hab, __const__ PRFPROFILE *pPrfProfile);
BOOL (*pPrfWriteProfileData) (HINI hini, PCSZ pszApp, PCSZ pszKey,
    CPVOID pData, ULONG ulDataLength);
/*
BOOL (*pPrfWriteProfileString) (HINI hini, PCSZ pszApp, PCSZ pszKey,
    PCSZ pszData);
 */

SV *
Prf_Get(pTHX_ HINI hini, PSZ app, PSZ key) {
    ULONG len;
    BOOL rc;
    SV *sv;

    if (CheckWinError(pPrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
    sv = newSVpv("", 0);
    SvGROW(sv, len + 1);
    if (CheckWinError(pPrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
	|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
	SvREFCNT_dec(sv);
	return &PL_sv_undef;
    }
    SvCUR_set(sv, len);
    *SvEND(sv) = 0;
    return sv;
}

I32
Prf_GetLength(HINI hini, PSZ app, PSZ key) {
    U32 len;

    if (CheckWinError(pPrfQueryProfileSize(hini, app, key, &len))) return -1;
    return len;
}

#define Prf_Set(hini, app, key, s, l)			\
	 (!(CheckWinError(pPrfWriteProfileData(hini, app, key, s, l))))

#define Prf_System(key)					\
	( (key) ? ( (key) == 1  ? HINI_USERPROFILE	\
				: ( (key) == 2 ? HINI_SYSTEMPROFILE \
						: (die("Wrong profile id %i", key), 0) )) \
	  : HINI_PROFILE)

SV*
Prf_Profiles(pTHX)
{
    AV *av = newAV();
    SV *rv;
    char user[257];
    char system[257];
    PRFPROFILE info = { 257, user, 257, system};
    
    if (CheckWinError(pPrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
    if (info.cchUserName > 257 || info.cchSysName > 257)
	die("Panic: Profile names too long");
    av_push(av, newSVpv(user, info.cchUserName - 1));
    av_push(av, newSVpv(system, info.cchSysName - 1));
    rv = newRV((SV*)av);
    SvREFCNT_dec(av);
    return rv;
}

BOOL
Prf_SetUser(pTHX_ SV *sv)
{
    char user[257];
    char system[257];
    PRFPROFILE info = { 257, user, 257, system};
    
    if (!SvPOK(sv)) die("User profile name not defined");
    if (SvCUR(sv) > 256) die("User profile name too long");
    if (CheckWinError(pPrfQueryProfile(Perl_hab, &info))) return 0;
    if (info.cchSysName > 257)
	die("Panic: System profile name too long");
    info.cchUserName = SvCUR(sv) + 1;
    info.pszUserName = SvPVX(sv);
    return !CheckWinError(pPrfReset(Perl_hab, &info));
}

MODULE = OS2::PrfDB		PACKAGE = OS2::Prf PREFIX = Prf_

HINI
Prf_Open(pszFileName)
 PSZ     pszFileName;

BOOL
Prf_Close(hini)
 HINI     hini;

SV *
Prf_Get(hini, app, key)
 HINI hini;
 PSZ app;
 PSZ key;
CODE:
    RETVAL = Prf_Get(aTHX_ hini, app, key);
OUTPUT:
    RETVAL

int
Prf_Set(hini, app, key, s, l = (SvPOK(ST(3)) ? SvCUR(ST(3)): -1))
 HINI hini;
 PSZ app;
 PSZ key;
 PSZ s;
 ULONG l;

I32
Prf_GetLength(hini, app, key)
 HINI hini;
 PSZ app;
 PSZ key;

HINI
Prf_System(key)
 int key;

SV*
Prf_Profiles()
CODE:
    RETVAL = Prf_Profiles(aTHX);
OUTPUT:
    RETVAL

BOOL
Prf_SetUser(sv)
 SV *sv
CODE:
    RETVAL = Prf_SetUser(aTHX_ sv);
OUTPUT:
    RETVAL

BOOT:
	Acquire_hab();
	AssignFuncPByORD(pPrfQueryProfileSize,	ORD_PRF32QUERYPROFILESIZE);
	AssignFuncPByORD(pPrfOpenProfile,	ORD_PRF32OPENPROFILE);
	AssignFuncPByORD(pPrfCloseProfile,	ORD_PRF32CLOSEPROFILE);
	AssignFuncPByORD(pPrfQueryProfile,	ORD_PRF32QUERYPROFILE);
	AssignFuncPByORD(pPrfReset,		ORD_PRF32RESET);
	AssignFuncPByORD(pPrfQueryProfileData,	ORD_PRF32QUERYPROFILEDATA);
	AssignFuncPByORD(pPrfWriteProfileData,	ORD_PRF32WRITEPROFILEDATA);