perl 5.003_02: [no incremental changelog available]

7 files changed, 666 insertions, 0 deletions

diff --git a/os2/OS2/PrfDB/Changes b/os2/OS2/PrfDB/Changes
new file mode 100644
index 0000000000..3e8bf3f580
--- /dev/null
+++ b/os2/OS2/PrfDB/Changes
@@ -0,0 +1,5 @@
+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.
diff --git a/os2/OS2/PrfDB/MANIFEST b/os2/OS2/PrfDB/MANIFEST
new file mode 100644
index 0000000000..fb96b03c5d
--- /dev/null
+++ b/os2/OS2/PrfDB/MANIFEST
@@ -0,0 +1,7 @@
+Changes
+MANIFEST
+Makefile.PL
+PrfDB.pm
+PrfDB.xs
+t/os2_prfdb.t
+typemap
diff --git a/os2/OS2/PrfDB/Makefile.PL b/os2/OS2/PrfDB/Makefile.PL
new file mode 100644
index 0000000000..c591c0490c
--- /dev/null
+++ b/os2/OS2/PrfDB/Makefile.PL
@@ -0,0 +1,10 @@
+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
+    'LIBS'	=> [''],   # e.g., '-lm' 
+    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
+    'INC'	=> '',     # e.g., '-I/usr/include/other' 
+);
diff --git a/os2/OS2/PrfDB/PrfDB.pm b/os2/OS2/PrfDB/PrfDB.pm
new file mode 100644
index 0000000000..d404c8b1d3
--- /dev/null
+++ b/os2/OS2/PrfDB/PrfDB.pm
@@ -0,0 +1,314 @@
+package OS2::PrfDB;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(Exporter DynaLoader);
+# 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.
+@EXPORT = qw(
+	     AnyIni UserIni SystemIni
+	    );
+$VERSION = '0.02';
+
+bootstrap 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;
+}
+
+use vars qw{$debug @ISA};
+use Tie::Hash;
+@ISA = qw{Tie::Hash};
+
+# 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 vars qw{$debug @ISA};
+use Tie::Hash;
+@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 extention 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
+
diff --git a/os2/OS2/PrfDB/PrfDB.xs b/os2/OS2/PrfDB/PrfDB.xs
new file mode 100644
index 0000000000..a5b2c89ca6
--- /dev/null
+++ b/os2/OS2/PrfDB/PrfDB.xs
@@ -0,0 +1,131 @@
+#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(PrfOpenProfile(Perl_hab, (pszFileName)))
+#define Prf_Close(hini) (!CheckWinError(PrfCloseProfile(hini)))
+
+SV *
+Prf_Get(HINI hini, PSZ app, PSZ key) {
+    ULONG len;
+    BOOL rc;
+    SV *sv;
+
+    if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &sv_undef;
+    sv = newSVpv("", 0);
+    SvGROW(sv, len);
+    if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
+	|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
+	SvREFCNT_dec(sv);
+	return &sv_undef;
+    }
+    SvCUR_set(sv, len);
+    *SvEND(sv) = 0;
+    return sv;
+}
+
+U32
+Prf_GetLength(HINI hini, PSZ app, PSZ key) {
+    U32 len;
+
+    if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return -1;
+    return len;
+}
+
+#define Prf_Set(hini, app, key, s, l)			\
+	 (!(CheckWinError(PrfWriteProfileData(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()
+{
+    AV *av = newAV();
+    SV *rv;
+    char user[257];
+    char system[257];
+    PRFPROFILE info = { 257, user, 257, system};
+    
+    if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &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(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(PrfQueryProfile(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(PrfReset(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;
+
+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;
+
+U32
+Prf_GetLength(hini, app, key)
+ HINI hini;
+ PSZ app;
+ PSZ key;
+
+HINI
+Prf_System(key)
+ int key;
+
+SV*
+Prf_Profiles()
+
+BOOL
+Prf_SetUser(sv)
+ SV *sv
+
+BOOT:
+	Acquire_hab();
diff --git a/os2/OS2/PrfDB/t/os2_prfdb.t b/os2/OS2/PrfDB/t/os2_prfdb.t
new file mode 100644
index 0000000000..4c0883db50
--- /dev/null
+++ b/os2/OS2/PrfDB/t/os2_prfdb.t
@@ -0,0 +1,185 @@
+BEGIN {
+    chdir 't' if -d 't/lib';
+    @INC = '../lib' if -d 'lib';
+    require Config; import Config;
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::PrfDB\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..48\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use OS2::PrfDB;
+$loaded = 1;
+use strict;
+
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+my $inifile = "my.ini";
+
+unlink $inifile if -w $inifile;
+
+my $ini = OS2::Prf::Open($inifile);
+print( ($ini ? "": "not "), "ok 2\n# HINI=`$ini'\n");
+
+print( (OS2::Prf::GetLength($ini,'aaa', 'bbb') != -1) ? 
+    "not ok 3\n# err: `$^E'\n" : "ok 3\n");
+
+
+print( OS2::Prf::Set($ini,'aaa', 'bbb','xyz') ? "ok 4\n" :
+    "not ok 4\n# err: `$^E'\n");
+
+my $len = OS2::Prf::GetLength($ini,'aaa', 'bbb');
+print( $len == 3 ? "ok 5\n" : "not ok 5# len: `$len' err: `$^E'\n");
+
+my $val = OS2::Prf::Get($ini,'aaa', 'bbb');
+print( $val eq 'xyz' ? "ok 6\n" : "not ok 6# val: `$val' err: `$^E'\n");
+
+$val = OS2::Prf::Get($ini,'aaa', undef);
+print( $val eq "bbb\0" ? "ok 7\n" : "not ok 7# val: `$val' err: `$^E'\n");
+
+$val = OS2::Prf::Get($ini, undef, undef);
+print( $val eq "aaa\0" ? "ok 8\n" : "not ok 8# val: `$val' err: `$^E'\n");
+
+my $res = OS2::Prf::Set($ini,'aaa', 'bbb',undef);
+print( $res ? "ok 9\n" : "not ok 9# err: `$^E'\n");
+
+$val = OS2::Prf::Get($ini, undef, undef);
+print( (! defined $val) ? "ok 10\n" : "not ok 10# val: `$val' err: `$^E'\n");
+
+$val = OS2::Prf::Get($ini,'aaa', undef);
+print( (! defined $val) ? "ok 11\n" : "not ok 11# val: `$val' err: `$^E'\n");
+
+print((OS2::Prf::Close($ini) ? "" : "not ") . "ok 12\n");
+
+my $files = OS2::Prf::Profiles();
+print( (defined $files) ? "ok 13\n" : "not ok 13# err: `$^E'\n");
+print( (@$files == 2) ? "ok 14\n" : "not ok 14# `@$files' err: `$^E'\n");
+print "# `@$files'\n";
+
+$ini = OS2::Prf::Open($inifile);
+print( ($ini ? "": "not "), "ok 15\n# HINI=`$ini'\n");
+
+
+print( OS2::Prf::Set($ini,'aaa', 'ccc','xyz') ? "ok 16\n" :
+    "not ok 16\n# err: `$^E'\n");
+
+print( OS2::Prf::Set($ini,'aaa', 'ddd','123') ? "ok 17\n" :
+    "not ok 17\n# err: `$^E'\n");
+
+print( OS2::Prf::Set($ini,'bbb', 'xxx','abc') ? "ok 18\n" :
+    "not ok 18\n# err: `$^E'\n");
+
+print( OS2::Prf::Set($ini,'bbb', 'yyy','456') ? "ok 19\n" :
+    "not ok 19\n# err: `$^E'\n");
+
+my %hash1;
+
+tie %hash1, 'OS2::PrfDB::Sub', $inifile, 'aaa';
+$OS2::PrfDB::Sub::debug = 1;
+print "ok 20\n";
+
+my @a1 = keys %hash1;
+print (@a1 == 2 ? "ok 21\n" : "not ok 21\n# `@a1'\n");
+
+my @a2 = sort @a1;
+print ("@a2" eq "ccc ddd" ? "ok 22\n" : "not ok 22\n# `@a2'\n");
+
+$val = $hash1{ccc};
+print ($val eq "xyz" ? "ok 23\n" : "not ok 23\n# `$val'\n");
+
+$val = $hash1{ddd};
+print ($val eq "123" ? "ok 24\n" : "not ok 24\n# `$val'\n");
+
+print (exists $hash1{ccc} ? "ok 25\n" : "not ok 25\n# `$val'\n");
+
+print (!exists $hash1{hhh} ? "ok 26\n" : "not ok 26\n# `$val'\n");
+
+$hash1{hhh} = 12;
+print (exists $hash1{hhh} ? "ok 27\n" : "not ok 27\n# `$val'\n");
+
+$val = $hash1{hhh};
+print ($val eq "12" ? "ok 28\n" : "not ok 28\n# `$val'\n");
+
+delete $hash1{ccc};
+
+untie %hash1;
+print "ok 29\n";
+
+tie %hash1, 'OS2::PrfDB::Sub', $inifile, 'aaa';
+print "ok 30\n";
+
+@a1 = keys %hash1;
+print (@a1 == 2 ? "ok 31\n" : "not ok 31\n# `@a1'\n");
+
+@a2 = sort @a1;
+print ("@a2" eq "ddd hhh" ? "ok 32\n" : "not ok 32\n# `@a2'\n");
+
+print (exists $hash1{hhh} ? "ok 33\n" : "not ok 33\n# `$val'\n");
+
+$val = $hash1{hhh};
+print ($val eq "12" ? "ok 34\n" : "not ok 34\n# `$val'\n");
+
+%hash1 = ();
+print "ok 35\n";
+
+%hash1 = ( hhh => 12, ddd => 5);
+
+untie %hash1;
+
+my %hash;
+
+tie %hash, 'OS2::PrfDB', $inifile;
+print "ok 36\n";
+
+@a1 = keys %hash;
+print (@a1 == 2 ? "ok 37\n" : "not ok 37\n# `@a1'\n");
+
+@a2 = sort @a1;
+print ("@a2" eq "aaa bbb" ? "ok 38\n" : "not ok 38\n# `@a2'\n");
+
+print (exists $hash{aaa} ? "ok 39\n" : "not ok 39\n# `$val'\n");
+
+$val = $hash{aaa};
+print (ref $val eq "HASH" ? "ok 40\n" : "not ok 40\n# `$val'\n");
+
+%hash1 = %$val;
+print "ok 41\n";
+
+@a1 = keys %hash1;
+print (@a1 == 2 ? "ok 42\n" : "not ok 31\n# `@a1'\n");
+
+@a2 = sort @a1;
+print ("@a2" eq "ddd hhh" ? "ok 43\n" : "not ok 43\n# `@a2'\n");
+
+print (exists $hash1{hhh} ? "ok 44\n" : "not ok 44\n# `$val'\n");
+
+$val = $hash1{hhh};
+print ($val eq "12" ? "ok 45\n" : "not ok 45\n# `$val'\n");
+
+$hash{nnn}{mmm} = 67;
+print "ok 46\n";
+
+untie %hash;
+
+my %hash2;
+
+tie %hash2, 'OS2::PrfDB', $inifile;
+print "ok 47\n";
+
+print ($hash2{nnn}->{mmm} eq "67" ? "ok 48\n" : "not ok 48\n# `$val'\n");
diff --git a/os2/OS2/PrfDB/typemap b/os2/OS2/PrfDB/typemap
new file mode 100644
index 0000000000..0b91f3750a
--- /dev/null
+++ b/os2/OS2/PrfDB/typemap
@@ -0,0 +1,14 @@
+BOOL			T_IV
+ULONG			T_IV
+HINI			T_IV
+HAB			T_IV
+PSZ			T_PVNULL
+
+#############################################################################
+INPUT
+T_PVNULL
+	$var = ( SvOK($arg) ? ($type)SvPV($arg,na) : NULL )
+#############################################################################
+OUTPUT
+T_PVNULL
+	sv_setpv((SV*)$arg, $var);