This article shows how to access Cobol files from other languages.
And the files are of course indexed files aka ISAM files not plain text files as there are no problems reading plain text files from any language.
The article is resusing a lot of content from the article NoSQL - Key Value Store. The main difference is that while that article mostly used C as basis then this article use Cobol as basis.
Cobol indexed files have a standard interface but the underlying implementation is compiler and platform specific.
This article will look at 3 different implementations:
GNU Cobol is open source software under GPL license.
BDB is available under either commercial license from Oracle or as open source software under AGPL.
VBISAM is open source software under LGPL license.
VMS Cobol is a commercial product from VSI.
RMS is part of the VMS operating system.
Please check the implications of AGPL license before taking BDB under AGPL license.
Examples will assume GNU Cobol is using default setup and storing integers in big endian format.
This is the Cobol code that will be used as starting point.
test.cob:
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST-PROGRAM.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL D-FILE ASSIGN TO "TESTDB.ISQ" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS D-ID.
DATA DIVISION.
FILE SECTION.
FD D-FILE.
01 D-RECORD.
03 D-ID PIC X(8).
03 D-IV PIC 9(8) COMP.
03 D-ZV PIC 9(5)V9(2) PACKED-DECIMAL.
03 D-XV COMP-2.
03 D-SLEN PIC 9(4) COMP.
03 D-SV PIC X(50).
WORKING-STORAGE SECTION.
01 NREC PIC 9(4) COMP VALUE 1000.
01 OTEN PIC 9(5)V9(2) PACKED-DECIMAL VALUE 0.10.
01 BLANK-VAL PIC X(8) VALUE " ".
01 EOF-FLAG PIC X.
01 DONE-FLAG PIC X.
01 WID PIC 9(4) DISPLAY.
01 IV PIC 9(4) DISPLAY.
01 ZV PIC 9(4)V9(2) DISPLAY.
01 XV PIC 9(4)V9(2) DISPLAY.
01 SLEN PIC 9(2) DISPLAY.
01 SV PIC X(50).
01 I PIC 9(4) DISPLAY.
01 N PIC 9(4) DISPLAY.
01 N2 PIC 9(4) DISPLAY.
01 STOP-ID PIC X(8).
PROCEDURE DIVISION.
MAIN-PARAGRAPH.
OPEN I-O D-FILE
MOVE BLANK-VAL TO D-ID
START D-FILE KEY GREATER THAN D-ID
INVALID KEY DISPLAY "Empty file"
END-START
PERFORM VARYING I FROM 1 BY 1 UNTIL I > NREC
COMPUTE WID = 1000 + I
STRING "Key#" DELIMITED BY SIZE WID DELIMITED BY SIZE INTO D-ID
COMPUTE D-IV = I
COMPUTE D-XV = I
COMPUTE D-ZV = I
COMPUTE D-SLEN = 18
STRING "This is value " DELIMITED BY SIZE I DELIMITED BY SIZE INTO D-SV
WRITE D-RECORD
INVALID KEY DISPLAY "Error writing"
NOT INVALID KEY CONTINUE
END-WRITE
END-PERFORM
COMPUTE WID = 1077
STRING "Key#" DELIMITED BY SIZE WID DELIMITED BY SIZE INTO D-ID
PERFORM DUMP-PARAGRAPH
DELETE D-FILE
INVALID KEY DISPLAY "Error deleting"
NOT INVALID KEY CONTINUE
END-DELETE
PERFORM DUMP-PARAGRAPH
COMPUTE WID = 1088
STRING "Key#" DELIMITED BY SIZE WID DELIMITED BY SIZE INTO D-ID
PERFORM DUMP-PARAGRAPH
READ D-FILE
INVALID KEY DISPLAY "Error reading"
NOT INVALID KEY CONTINUE
END-READ
COMPUTE D-IV = D-IV + 1
COMPUTE D-ZV = D-ZV + OTEN
COMPUTE D-XV = D-XV + 0.1
MOVE D-SLEN TO SLEN
MOVE D-SV TO SV
STRING SV(1:SLEN) DELIMITED BY SIZE " updated" DELIMITED BY SIZE INTO D-SV
COMPUTE D-SLEN = D-SLEN + 8
REWRITE D-RECORD
INVALID KEY DISPLAY "Error updating"
NOT INVALID KEY CONTINUE
END-REWRITE
PERFORM DUMP-PARAGRAPH
MOVE BLANK-VAL TO D-ID
START D-FILE KEY IS GREATER THAN D-ID
INVALID KEY DISPLAY "Error rewinding"
NOT INVALID KEY CONTINUE
END-START
MOVE 'N' TO EOF-FLAG
MOVE 0 TO N
PERFORM UNTIL EOF-FLAG = 'Y'
READ D-FILE NEXT
AT END MOVE 'Y' TO EOF-FLAG
NOT AT END PERFORM CHECK-AND-COUNT-PARAGRAPH
END-READ
END-PERFORM
DISPLAY N
COMPUTE WID = 1075
STRING "Key#" DELIMITED BY SIZE WID DELIMITED BY SIZE INTO D-ID
START D-FILE KEY IS GREATER THAN OR EQUAL TO D-ID
INVALID KEY DISPLAY "Error searching"
NOT INVALID KEY CONTINUE
END-START
COMPUTE WID = 1085
STRING "Key#" DELIMITED BY SIZE WID DELIMITED BY SIZE INTO STOP-ID
MOVE 'N' TO EOF-FLAG
MOVE 'N' TO DONE-FLAG
MOVE 0 TO N2
PERFORM UNTIL EOF-FLAG = 'Y' OR DONE-FLAG = 'Y'
READ D-FILE NEXT
AT END MOVE 'Y' TO EOF-FLAG
NOT AT END PERFORM COUNT-PARAGRAPH
END-READ
END-PERFORM
DISPLAY N2
CLOSE D-FILE
STOP RUN.
DUMP-PARAGRAPH.
DISPLAY "Key=" D-ID
READ D-FILE
INVALID KEY DISPLAY "Not found"
NOT INVALID KEY PERFORM DUMP-DATA-PARAGRAPH
END-READ.
DUMP-DATA-PARAGRAPH.
MOVE D-IV TO IV
MOVE D-ZV TO ZV
MOVE D-XV TO XV
MOVE D-SLEN TO SLEN
MOVE D-SV TO SV
DISPLAY "(" IV "," ZV "," XV "," SV(1:SLEN) ")".
CHECK-AND-COUNT-PARAGRAPH.
MOVE D-IV TO IV
MOVE D-XV TO XV
MOVE D-SLEN TO SLEN
MOVE D-SV TO SV
IF IV < 1 OR NREC < IV OR ZV < 1 OR NREC < ZV OR XV < 1 OR NREC < XV THEN
DISPLAY "Unexpected value: (" IV "," XV "," SV(1:SLEN) ")"
END-IF
COMPUTE N = N + 1.
COUNT-PARAGRAPH.
IF D-ID GREATER THAN OR EQUAL TO STOP-ID THEN
MOVE 'Y' TO DONE-FLAG
ELSE
COMPUTE N2 = N2 + 1
END-IF.
I am not sure that this code is how a Cobol programmer would write it, because I am not a Cobol programmer, but it should be sufficient as an example.
Build and run with GNU Cobol:
cobc -Wall -free -x test.cob
test
Build and run with VMS Cobol:
$ cobol/float=g_float test
$ link test
$ run test
Let us first look at implementation specific API's.
Cobol nicely encapsulates those and the same Cobol code works with all of them, but each implementation also exposes a specific API - a C API or a language neutral API.
BDB comes with libraries and API's for a number of languages including: C, .NET, Java and Python. Examples will be shown for C, .NET and Java.
The architecture looks like:
C does not support decimals and the file happens to contain decimals. This code use a hack to store the data in an integer with an implied decimal point. For real use a proper decimal library would be needed.
test.c:
/* standard C headers */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
/* BDB headers */
#include "db.h"
/* convert between little and big endian - custom to avoid system specific includes */
static short int NTOHS(short int v)
{
short int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[1];
p[1] = tmpc;
#endif
return tmpi;
}
static long int NTOHL(long int v)
{
long int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[3];
p[3] = tmpc;
tmpc = p[1];
p[1] = p[2];
p[2] = tmpc;
#endif
return tmpi;
}
static short int HTONS(short int v)
{
short int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[1];
p[1] = tmpc;
#endif
return tmpi;
}
static long int HTONL(long int v)
{
long int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[3];
p[3] = tmpc;
tmpc = p[1];
p[1] = p[2];
p[2] = tmpc;
#endif
return tmpi;
}
/* read and write BCD - assume int is big enough */
static int READBCD(char *p, int n)
{
int i, upp, low;
int res = 0;
for(i = 0; i < n; i++)
{
upp = (p[i] & 0xF0) >> 4;
low = p[i] & 0x0F;
res = res * 10 + upp;
if(low <= 10)
{
res = res * 10 + low;
}
else
{
if(low == 11 | low == 13) res = -res;
}
}
return res;
}
static void WRITEBCD(int v, char *p, int n)
{
int i, upp, low;
int tmp = v;
for(i = n - 1; i >= 0; i--)
{
if(i == n - 1)
{
low = 0x0F; /* assume unsigned */
}
else
{
low = tmp % 10;
tmp = tmp / 10;
}
upp = tmp % 10;
tmp = tmp / 10;
p[i] = (upp << 4) | low;
}
}
/* data structure */
struct data
{
char id[8 + 1];
int iv;
int zv; /* implied 2 decimals */
double xv;
char sv[50 + 1];
};
static int length(struct data *d)
{
return 8 + 4 + 4 + 8 + 2 + strlen(d->sv);
}
static void serialize(struct data *d, char *buf)
{
long int temp4;
short int temp2;
short int slen = (short int)strlen(d->sv);
char *p = buf;
memcpy(p, &d->id[0], 8);
p += 8;
temp4 = HTONL(d->iv);
memcpy(p, &temp4, 4);
p += 4;
WRITEBCD(d->zv, p, 4);
p += 4;
memcpy(p, &d->xv, 8);
p += 8;
temp2 = HTONS(slen);
memcpy(p, &temp2, 2);
p += 2;
memcpy(p, &d->sv[0], slen);
}
static void deserialize(char *buf, struct data *d)
{
short int slen = 0;
char *p = buf;
memcpy(&d->id[0], p, 8);
p += 8;
memcpy(&d->iv, p, 4);
d->iv = NTOHL(d->iv);
p += 4;
d->zv = READBCD(p, 4);
p += 4;
memcpy(&d->xv, p, 8);
p += 8;
memcpy(&slen, p, 2);
slen = NTOHS(slen);
p += 2;
memcpy(&d->sv[0], p, slen);
d->sv[slen] = '\0';
}
/* error handling functions */
void db_exit(char *msg, int stat)
{
printf("DB error %s: %s\n", msg, db_strerror(stat));
exit(1);
}
static void dump(DB *db, char *keybuf)
{
int stat;
DBT key;
DBT value;
struct data d;
printf("Key=%s\n", keybuf);
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
key.data = keybuf;
key.size = strlen(keybuf);
value.size = sizeof(struct data);
stat = db->get(db, NULL, &key, &value, 0);
if(stat == 0)
{
deserialize(value.data, &d);
printf("(%d,%d.%02d,%f,%s)\n", d.iv, d.zv / 100, d.zv % 100, d.xv, d.sv);
}
else if(stat == DB_NOTFOUND)
{
printf("Not found\n");
}
else
{
db_exit("db->get", stat);
}
}
static const char *DBNAME = "testdb.isq";
static const int NREC = 1000;
static const int C_OFFSET = 2000; // 2 * NREC;
int main()
{
int stat;
DB *db;
DBC *it, *it2;
DBT key, value, itkey;
struct data d;
char keybuf[32], termkeybuf[32], valuebuf[256];
int n, n2;
/* initialize */
stat = db_create(&db, NULL, 0);
if(stat != 0)
{
db_exit("db_create", stat);
}
/* get connection */
stat = db->open(db, NULL, DBNAME, NULL, DB_BTREE, DB_CREATE, 0664); /* DB_HASH is alternative to DB_BTREE */
if(stat != 0)
{
db_exit("db->open", stat);
}
/* put data */
for(int i = 0; i < NREC; i++)
{
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
sprintf(keybuf, "Key#%d", C_OFFSET + i + 1);
key.data = keybuf;
key.size = strlen(keybuf);
memcpy(d.id, keybuf, 8);
d.iv = i + 1;
d.zv = (i + 1) * 100;
d.xv = i + 1.0;
sprintf(d.sv, "This is value %d", i + 1);
serialize(&d, valuebuf);
value.data = valuebuf;
value.size = length(&d);
stat = db->put(db, NULL, &key, &value, 0);
if(stat != 0)
{
db_exit("db->put", stat);
}
}
/* */
sprintf(keybuf, "Key#%d", C_OFFSET + 77);
/* get */
dump(db, keybuf);
/* delete */
memset(&key, 0, sizeof(DBT));
key.data = keybuf;
key.size = strlen(keybuf);
stat = db->del(db, NULL, &key, 0);
if(stat != 0)
{
db_exit("db->del", stat);
}
/* get non existing */
dump(db, keybuf);
/* */
sprintf(keybuf, "Key#%d", C_OFFSET + 88);
/* update and get */
dump(db, keybuf);
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
key.data = keybuf;
key.size = strlen(keybuf);
value.size = sizeof(struct data);
stat = db->get(db, NULL, &key, &value, 0);
if(stat != 0)
{
db_exit("db->get", stat);
}
deserialize(value.data, &d);
d.iv = d.iv + 1;
d.zv = d.zv + 10;
d.xv = d.xv + 0.1;
strcat(d.sv, " updated");
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
serialize(&d, valuebuf);
key.data = keybuf;
key.size = strlen(keybuf);
value.data = valuebuf;
value.size = length(&d);
stat = db->put(db, NULL, &key, &value, 0);
if(stat != 0)
{
db_exit("db->put", stat);
}
dump(db, keybuf);
/* list all */
n = 0;
stat = db->cursor(db, NULL, &it, 0);
if(stat != 0)
{
db_exit("db->cursor", stat);
}
for(;;)
{
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
stat = it->get(it, &key, &value, DB_NEXT);
if(stat == 0)
{
memcpy(keybuf, key.data, key.size);
keybuf[key.size] = '\0';
if(strstr(keybuf, "Key#") != keybuf)
{
printf("Unexpected key: %s\n", keybuf);
}
deserialize(value.data, &d);
if(d.iv < 1 || NREC < d.iv || d.zv < 100 || NREC * 100 < d.zv || d.xv < 1 || NREC < d.xv)
{
printf("Unexpected value: (%d,%d.%02d,%f,%s)\n", d.iv, d.zv / 100, d.zv % 100, d.xv, d.sv);
}
n++;
}
else if(stat == DB_NOTFOUND)
{
/* done */
break;
}
else
{
db_exit("dbc->get", stat);
}
}
printf("%d\n", n);
/* list keys where "Key#n075" <= key < "Key#n085" */
n2 = 0;
stat = db->cursor(db, NULL, &it2, 0);
if(stat != 0)
{
db_exit("db->cursor", stat);
}
sprintf(keybuf, "Key#%d", C_OFFSET + 75);
sprintf(termkeybuf, "Key#%d", C_OFFSET + 85);
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
key.data = keybuf;
key.size = strlen(keybuf);
value.size = sizeof(struct data);
stat = it2->get(it2, &key, &value, DB_SET);
for(;;)
{
if(stat == 0)
{
memcpy(keybuf, key.data, key.size);
keybuf[key.size] = '\0';
if(strcmp(keybuf, termkeybuf) >= 0) break;
n2++;
}
else if(stat == DB_NOTFOUND)
{
/* done */
break;
}
else
{
db_exit("dbc->get", stat);
}
memset(&key, 0, sizeof(DBT));
memset(&value, 0, sizeof(DBT));
stat = it2->get(it2, &key, &value, DB_NEXT);
}
printf("%d\n", n2);
/* close */
db->close(db, 0);
return 0;
}
Required:
Build and run with MSVC++:
cl /I%BDB% test.c %BDB%\Win32\Debug\libdb181d.lib
test
test.cs:
using System;
using System.Collections.Generic;
using System.IO;
using System.Text;
using BerkeleyDB;
namespace BDB
{
public class Data
{
public string Id { get; set; }
public int Iv { get; set; }
public decimal Zv { get; set; }
public double Xv { get; set; }
public string Sv { get; set; }
public override string ToString()
{
return string.Format("(iv: {0}, zv: {1:F2}, xv: {2}, sv: {3})", Iv, Zv, Xv, Sv);
}
}
public class Program
{
private static int HTON(int v)
{
if(BitConverter.IsLittleEndian)
{
byte[] buf = BitConverter.GetBytes(v);
Array.Reverse(buf);
return BitConverter.ToInt32(buf, 0);
}
else
{
return v;
}
}
private static int NTOH(int v)
{
if(BitConverter.IsLittleEndian)
{
byte[] buf = BitConverter.GetBytes(v);
Array.Reverse(buf);
return BitConverter.ToInt32(buf, 0);
}
else
{
return v;
}
}
private static short HTON(short v)
{
if(BitConverter.IsLittleEndian)
{
byte[] buf = BitConverter.GetBytes(v);
Array.Reverse(buf);
return BitConverter.ToInt16(buf, 0);
}
else
{
return v;
}
}
private static short NTOH(short v)
{
if(BitConverter.IsLittleEndian)
{
byte[] buf = BitConverter.GetBytes(v);
Array.Reverse(buf);
return BitConverter.ToInt16(buf, 0);
}
else
{
return v;
}
}
private static decimal[] DECPOW = { 1.0m, 10.0m, 100.0m, 1000.0m, 10000.0m, 100000.0m, 1000000.0m };
private static decimal ReadBCD(byte[] b, int scale)
{
decimal res = 0;
for(int i = 0; i < b.Length; i++)
{
int upp = (b[i] & 0xF0) >> 4;
int low = b[i] & 0x0F;
res = res * 10 + upp;
if(low <= 10)
{
res = res * 10 + low;
}
else
{
if(low == 11 | low == 13) res = -res;
}
}
return res / DECPOW[scale];
}
private static byte[] WriteBCD(decimal v, int scale, int n)
{
byte[] res = new byte[n];
long tmp = (long)(v * DECPOW[scale]);
for(int i = n - 1; i >= 0; i--)
{
long low;
if(i == n - 1)
{
low = 0x0F; /* assume unsigned */
}
else
{
low = tmp % 10;
tmp = tmp / 10;
}
long upp = tmp % 10;
tmp = tmp / 10;
res[i] = (byte)((upp << 4) | low);
}
return res;
}
private static DatabaseEntry Prep(string key)
{
return new DatabaseEntry(Encoding.UTF8.GetBytes(key));
}
private static DatabaseEntry Serialize(Data d)
{
MemoryStream ms = new MemoryStream();
BinaryWriter bw = new BinaryWriter(ms);
bw.Write(Encoding.UTF8.GetBytes(d.Id));
bw.Write(HTON(d.Iv));
bw.Write(WriteBCD(d.Zv, 2, 4));
bw.Write(d.Xv);
bw.Write(HTON((short)d.Sv.Length));
bw.Write(Encoding.UTF8.GetBytes(d.Sv));
bw.Flush();
return new DatabaseEntry(ms.ToArray());
}
private static Data Deserialize(DatabaseEntry de)
{
MemoryStream ms = new MemoryStream(de.Data);
BinaryReader br = new BinaryReader(ms);
Data d = new Data();
byte[] temp = new byte[8];
br.Read(temp, 0, temp.Length);
d.Id = Encoding.UTF8.GetString(temp);
d.Iv = NTOH(br.ReadInt32());
temp = new byte[4];
br.Read(temp, 0, temp.Length);
d.Zv = ReadBCD(temp, 2);
d.Xv = br.ReadDouble();
int len = NTOH(br.ReadInt16());
temp = new byte[len];
br.Read(temp, 0, temp.Length);
d.Sv = Encoding.UTF8.GetString(temp);
return d;
}
private static void Dump(Database db, string key)
{
Console.WriteLine("Key={0}", key);
if(db.Exists(Prep(key)))
{
Data value = Deserialize(db.Get(Prep(key)).Value);
Console.WriteLine(value);
}
else
{
Console.WriteLine("Not found");
}
}
private const int NREC = 1000;
private const int DN_OFFSET = 3 * NREC;
public static void Main(string[] args)
{
using(Database db = BTreeDatabase.Open("testdb.isq", new BTreeDatabaseConfig()))
{
// put data
for (int i = 0; i < NREC; i++)
{
string putkey = "Key#" + (DN_OFFSET + i + 1);
Data value = new Data { Id = putkey, Iv = i + 1, Zv = i + 1, Xv = i + 1.0, Sv = string.Format("This is value {0}", i + 1) };
db.Put(Prep(putkey), Serialize(value));
}
string key;
key = "Key#" + (DN_OFFSET + 77);
// get
Dump(db, key);
// delete
db.Delete(Prep(key));
// get non existing
Dump(db, key);
//
key = "Key#" + (DN_OFFSET + 88);
// update and get
Dump(db, key);
Data updvalue = (Data)Deserialize(db.Get(Prep(key)).Value);
updvalue.Iv = updvalue.Iv + 1;
updvalue.Zv = updvalue.Zv + 0.10m;
updvalue.Xv = updvalue.Xv + 0.1;
updvalue.Sv = updvalue.Sv + " updated";
db.Put(Prep(key), Serialize(updvalue));
Dump(db, key);
// list all
using (Cursor it = db.Cursor())
{
int n = 0;
bool more = it.MoveFirst();
while (more)
{
string itkey = Encoding.UTF8.GetString(it.Current.Key.Data);
if(!itkey.StartsWith("Key#"))
{
Console.WriteLine("Unexpected key: " + itkey);
}
Data itvalue = Deserialize(it.Current.Value);
if (itvalue.Iv < 1 || NREC < itvalue.Iv)
{
Console.WriteLine("Unexpected value :" + itvalue);
}
n++;
more = it.MoveNext();
}
Console.WriteLine(n);
}
// list all - alternative
using (Cursor it1 = db.Cursor())
{
int n1 = 0;
foreach(KeyValuePair<DatabaseEntry, DatabaseEntry> kvp in it1)
{
String it1key = Encoding.UTF8.GetString(kvp.Key.Data);
if(!it1key.StartsWith("Key#"))
{
Console.WriteLine("Unexpected key: " + it1key);
}
Data it1value = Deserialize(kvp.Value);
if(it1value.Iv < 1 || NREC < it1value.Iv || it1value.Zv < 1 || NREC < it1value.Zv || it1value.Xv < 1 || NREC < it1value.Xv)
{
Console.WriteLine("Unexpected value :" + it1value);
}
n1++;
}
Console.WriteLine(n1);
}
// list keys where "Key#n075" <= key < "Key#n085"
using (Cursor it2 = db.Cursor())
{
int n2 = 0;
bool more = it2.Move(Prep("Key#" + (DN_OFFSET + 75)), true);
while (more)
{
string it2key = Encoding.UTF8.GetString(it2.Current.Key.Data);
if(string.Compare(it2key, "Key#" + (DN_OFFSET + 85)) >= 0) break;
n2++;
more = it2.MoveNext();
}
Console.WriteLine(n2);
}
}
}
}
}
Required:
Build and run:
csc /platform:x86 /r:libdb_dotnet181.dll test.cs
test
pause
Note that the BDB Java library and BDB-JE (BDB Java Edition) is not the same. The first is a Java library accessing a native library that accesses files in one format while BDB-JE is a Java library that accesses files in another format.
Data.java:
import java.io.Serializable;
import java.math.BigDecimal;
public class Data implements Serializable {
private String id;
private int iv;
private BigDecimal zv;
private double xv;
private String sv;
public Data() {
this("", 0, BigDecimal.ZERO, 0.0, "");
}
public Data(String id, int iv, BigDecimal zv, double xv, String sv) {
super();
this.id = id;
this.iv = iv;
this.zv = zv;
this.xv = xv;
this.sv = sv;
}
public String getId() {
return id;
}
public void setId(String id) {
this.id = id;
}
public int getIv() {
return iv;
}
public void setIv(int iv) {
this.iv = iv;
}
public BigDecimal getZv() {
return zv;
}
public void setZv(BigDecimal zv) {
this.zv = zv;
}
public double getXv() {
return xv;
}
public void setXv(double xv) {
this.xv = xv;
}
public String getSv() {
return sv;
}
public void setSv(String sv) {
this.sv = sv;
}
@Override
public String toString() {
return String.format("{iv: %d, zv: %s, xv: %f, sv: %s}", iv, zv, xv, sv);
}
}
Test.java:
import java.io.IOException;
import java.io.UnsupportedEncodingException;
import java.math.BigDecimal;
import java.nio.ByteBuffer;
import java.nio.ByteOrder;
import com.sleepycat.db.Cursor;
import com.sleepycat.db.Database;
import com.sleepycat.db.DatabaseConfig;
import com.sleepycat.db.DatabaseEntry;
import com.sleepycat.db.DatabaseException;
import com.sleepycat.db.OperationStatus;
public class Test {
private static BigDecimal readBCD(byte[] b, int scale) {
long res = 0;
for(int i = 0; i < b.length; i++) {
int upp = (b[i] & 0xF0) >> 4;
int low = b[i] & 0x0F;
res = res * 10 + upp;
if(low <= 10) {
res = res * 10 + low;
} else {
if(low == 11 | low == 13) res = -res;
}
}
return new BigDecimal(res).divide(new BigDecimal(10).pow(scale)).setScale(scale);
}
private static byte[] writeBCD(BigDecimal v, int scale, int n) {
byte[] res = new byte[n];
long tmp = v.multiply(new BigDecimal(10).pow(scale)).longValue();
for(int i = n - 1; i >= 0; i--) {
long low;
if(i == n - 1) {
low = 0x0F; /* assume unsigned */
} else {
low = tmp % 10;
tmp = tmp / 10;
}
long upp = tmp % 10;
tmp = tmp / 10;
res[i] = (byte)((upp << 4) | low);
}
return res;
}
private static DatabaseEntry prep(String key) throws UnsupportedEncodingException {
return new DatabaseEntry(key.getBytes("UTF-8"));
}
private static DatabaseEntry serialize(Data o) throws IOException {
ByteBuffer bb = ByteBuffer.allocate(1000);
bb.order(ByteOrder.BIG_ENDIAN);
bb.put(o.getId().getBytes("UTF-8"));
bb.putInt(o.getIv());
bb.put(writeBCD(o.getZv(), 2, 4));
bb.order(ByteOrder.LITTLE_ENDIAN); // double is not in big endian
bb.putDouble(o.getXv());
bb.order(ByteOrder.BIG_ENDIAN);
byte[] b = o.getSv().getBytes("UTF-8");
bb.putShort((short)b.length);
bb.put(b);
int n = bb.position();
byte[] res = new byte[n];
bb.rewind();
bb.get(res);
return new DatabaseEntry(res);
}
private static Data deserialize(DatabaseEntry de) throws IOException, ClassNotFoundException {
ByteBuffer bb = ByteBuffer.wrap(de.getData());
bb.order(ByteOrder.BIG_ENDIAN);
byte[] temp = new byte[8];
bb.get(temp);
String id = new String(temp, "UTF-8");
int iv = bb.getInt();
temp = new byte[4];
bb.get(temp);
BigDecimal zv = readBCD(temp, 2);
bb.order(ByteOrder.LITTLE_ENDIAN); // double is not in big endian
double xv = bb.getDouble();
bb.order(ByteOrder.BIG_ENDIAN);
int len = bb.getShort();
temp = new byte[len];
bb.get(temp);
String sv = new String(temp, "UTF-8");
Data res = new Data(id, iv, zv, xv, sv);
return res;
}
private static void dump(Database db, String key) throws ClassNotFoundException, IOException, DatabaseException {
System.out.printf("Key=%s\n", key);
DatabaseEntry rawvalue = new DatabaseEntry();
if(db.get(null, prep(key), rawvalue, null) == OperationStatus.SUCCESS) {
Data value = deserialize(rawvalue);
System.out.println(value);
} else {
System.out.println("Not found");
}
}
private static final String DBNAME = "testdb.isq";
private static final int NREC = 1000;
private static final int JAVA_OFFSET = 4 * NREC;
public static void main(String[] args) throws DatabaseException, UnsupportedEncodingException, IOException, ClassNotFoundException {
Database db = new Database(DBNAME, null, new DatabaseConfig());
// put data
for(int i = 0; i < NREC; i++) {
String key = "Key#" + (JAVA_OFFSET + i + 1);
Data value = new Data();
value.setId(key);
value.setIv(i + 1);
value.setZv(new BigDecimal(i + 1).setScale(2));
value.setXv(i + 1.0);
value.setSv(String.format("This is value %d", i + 1));
db.put(null, prep(key), serialize(value));
}
//
String key;
key = "Key#" + (JAVA_OFFSET + 77);
// get
dump(db, key);
// delete
db.delete(null, prep(key));
// get non existing
dump(db, key);
//
key = "Key#" + (JAVA_OFFSET + 88);
// update and get
dump(db, key);
DatabaseEntry rawvalue = new DatabaseEntry();
db.get(null, prep(key), rawvalue, null);
Data value = (Data)deserialize(rawvalue);
value.setIv(value.getIv() + 1);
value.setZv(value.getZv().add(new BigDecimal("0.10")));
value.setXv(value.getXv() + 0.1);
value.setSv(value.getSv() + " updated");
db.put(null, prep(key), serialize(value));
dump(db, key);
// list all
Cursor it = db.openCursor(null, null);
DatabaseEntry itrawkey = new DatabaseEntry();
DatabaseEntry itrawvalue = new DatabaseEntry();
OperationStatus itstat = it.getFirst(itrawkey, itrawvalue, null);
int n = 0;
while(itstat == OperationStatus.SUCCESS) {
String itkey = new String(itrawkey.getData(), "UTF-8");
if(!itkey.startsWith("Key#")) {
System.out.println("Unexpected key: " + itkey);
}
Data itvalue = (Data)deserialize(itrawvalue);
if(itvalue.getIv() < 1 || NREC < itvalue.getIv() ||
itvalue.getZv().compareTo(BigDecimal.ONE) < 0 || new BigDecimal(NREC).compareTo(itvalue.getZv()) < 0 ||
itvalue.getXv() < 1 || NREC < itvalue.getXv()) {
System.out.println("Unexpected value: " + itvalue);
}
n++;
itstat = it.getNext(itrawkey, itrawvalue, null);
}
it.close();
System.out.println(n);
// list keys where "Key#n075" <= key < "Key#n085"
Cursor it2 = db.openCursor(null, null);
DatabaseEntry it2rawkey = prep("Key#" + (JAVA_OFFSET + 75));
DatabaseEntry it2rawvalue = new DatabaseEntry();
OperationStatus it2stat = it2.getSearchKey(it2rawkey, it2rawvalue, null);
int n2 = 0;
while(it2stat == OperationStatus.SUCCESS) {
String it2key = new String(it2rawkey.getData(), "UTF-8");
if(it2key.compareTo("Key#" + (JAVA_OFFSET + 85)) >= 0) break;
n2++;
it2stat = it2.getNext(it2rawkey, it2rawvalue, null);
}
it2.close();
System.out.println(n2);
//
db.close();
}
}
Required:
Build and run:
javac -cp %BDB%\lang\java\db.jar Test.java Data.java
java -cp .;%BDB%\lang\java\db.jar Test
VBISAM is a C library. For compatibility reasons we use the version that comes with GNU Cobol.
The architecture looks like:
C does not support decimals and the file happens to contain decimals. This code use a hack to store the data in an integer with an implied decimal point. For real use a proper decimal library would be needed.
test.c:
/* standard C headers */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
/* VBISAM headers */
#include "vbisam.h"
/* convert between little and big endian - custom to avoid system specific includes */
static short int NTOHS(short int v)
{
short int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[1];
p[1] = tmpc;
#endif
return tmpi;
}
static long int NTOHL(long int v)
{
long int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[3];
p[3] = tmpc;
tmpc = p[1];
p[1] = p[2];
p[2] = tmpc;
#endif
return tmpi;
}
static short int HTONS(short int v)
{
short int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[1];
p[1] = tmpc;
#endif
return tmpi;
}
static long int HTONL(long int v)
{
long int tmpi = v;
#ifndef BIG_ENDIAN
char *p = (char *)&tmpi;
char tmpc;
tmpc = p[0];
p[0] = p[3];
p[3] = tmpc;
tmpc = p[1];
p[1] = p[2];
p[2] = tmpc;
#endif
return tmpi;
}
/* read and write BCD - assume int is big enough */
static int READBCD(char *p, int n)
{
int i, upp, low;
int res = 0;
for(i = 0; i < n; i++)
{
upp = (p[i] & 0xF0) >> 4;
low = p[i] & 0x0F;
res = res * 10 + upp;
if(low <= 10)
{
res = res * 10 + low;
}
else
{
if(low == 11 | low == 13) res = -res;
}
}
return res;
}
static void WRITEBCD(int v, char *p, int n)
{
int i, upp, low;
int tmp = v;
for(i = n - 1; i >= 0; i--)
{
if(i == n - 1)
{
low = 12; /* assume positive/unsigned */
}
else
{
low = tmp % 10;
tmp = tmp / 10;
}
upp = tmp % 10;
tmp = tmp / 10;
p[i] = (upp << 4) | low;
}
}
/* data structure */
struct data
{
char id[8 + 1];
int iv;
int zv; /* implied 2 decimals */
double xv;
char sv[50 + 1];
};
static int length(struct data *d)
{
return 8 + 4 + 4 + 8 + 2 + strlen(d->sv);
}
static void serialize(struct data *d, char *buf)
{
long int temp4;
short int temp2;
short int slen = (short int)strlen(d->sv);
char *p = buf;
memcpy(p, &d->id[0], 8);
p += 8;
temp4 = HTONL(d->iv);
memcpy(p, &temp4, 4);
p += 4;
WRITEBCD(d->zv, p, 4);
p += 4;
memcpy(p, &d->xv, 8);
p += 8;
temp2 = HTONS(slen);
memcpy(p, &temp2, 2);
p += 2;
memcpy(p, &d->sv[0], slen);
}
static void deserialize(char *buf, struct data *d)
{
short int slen = 0;
char *p = buf;
memcpy(&d->id[0], p, 8);
p += 8;
memcpy(&d->iv, p, 4);
d->iv = NTOHL(d->iv);
p += 4;
d->zv = READBCD(p, 4);
p += 4;
memcpy(&d->xv, p, 8);
p += 8;
memcpy(&slen, p, 2);
slen = NTOHS(slen);
p += 2;
memcpy(&d->sv[0], p, slen);
d->sv[slen] = '\0';
}
/* error handling functions */
void db_exit(char *msg)
{
printf("DB error %s: %d\n", msg, iserrno);
exit(1);
}
static void dump(int db, struct data *d)
{
int stat;
char buf[256];
printf("Key=%s\n", d->id);
serialize(d, buf);
stat = isread(db, buf, ISEQUAL);
if(stat == 0)
{
deserialize(buf, d);
printf("(%d,%d.%02d,%f,%s)\n", d->iv, d->zv / 100, d->zv % 100, d->xv, d->sv);
}
else if(iserrno == ENOREC)
{
printf("Not found\n");
}
else
{
db_exit("isread");
}
}
static const char *DBNAME = "testdb.isq";
static const int NREC = 1000;
static const int C_OFFSET = 2000; // 2 * NREC;
int main()
{
int stat;
int db;
char buf[256];
char termkey[9];
struct data d;
int n, n2;
/* open */
db = isopen(DBNAME, ISINOUT + ISFIXLEN);
if(db < 0)
{
db_exit("isopen");
}
/* put data */
for(int i = 0; i < NREC; i++)
{
memset(buf, 0, sizeof(buf));
sprintf(d.id, "Key#%d", C_OFFSET + i + 1);
d.iv = i + 1;
d.zv = (i + 1) * 100;
d.xv = i + 1.0;
sprintf(d.sv, "This is value %d", i + 1);
serialize(&d, buf);
stat = iswrite(db, buf);
if(stat != 0)
{
db_exit("iswrite");
}
}
/* */
sprintf(d.id, "Key#%d", C_OFFSET + 77);
/* get */
dump(db, &d);
/* delete */
serialize(&d, buf);
stat = isdelete(db, buf);
if(stat != 0)
{
db_exit("isdelete");
}
/* get non existing */
dump(db, &d);
/* */
sprintf(d.id, "Key#%d", C_OFFSET + 88);
/* update and get */
dump(db, &d);
serialize(&d, buf);
stat = isread(db, buf, ISEQUAL);
if(stat != 0)
{
db_exit("isread");
}
deserialize(buf, &d);
d.iv = d.iv + 1;
d.zv = d.zv + 10;
d.xv = d.xv + 0.1;
strcat(d.sv, " updated");
serialize(&d, buf);
stat = isrewrite(db, buf);
if(stat != 0)
{
db_exit("iswrite");
}
dump(db, &d);
/* list all */
n = 0;
stat = isread(db, buf, ISFIRST);
for(;;)
{
if(stat == 0)
{
deserialize(buf, &d);
if(strstr(d.id, "Key#") != d.id)
{
printf("Unexpected key: %s\n", d.id);
}
if(d.iv < 1 || NREC < d.iv || d.zv < 100 || NREC * 100 < d.zv || d.xv < 1 || NREC < d.xv)
{
printf("Unexpected value: (%d,%d.%02d,%f,%s)\n", d.iv, d.zv / 100, d.zv % 100, d.xv, d.sv);
}
n++;
}
else if(iserrno == EENDFILE)
{
/* done */
break;
}
else
{
db_exit("isread");
}
stat = isread(db, buf, ISNEXT);
}
printf("%d\n", n);
/* list keys where "Key#n075" <= key < "Key#n085" */
n2 = 0;
sprintf(termkey, "Key#%d", C_OFFSET + 85);
sprintf(d.id, "Key#%d", C_OFFSET + 75);
serialize(&d, buf);
stat = isread(db, buf, ISGTEQ);
for(;;)
{
if(stat == 0)
{
deserialize(buf, &d);
if(strcmp(d.id, termkey) >= 0) break;
n2++;
}
else if(iserrno == EENDFILE)
{
/* done */
break;
}
else
{
db_exit("isread");
}
stat = isread(db, buf, ISNEXT);
}
printf("%d\n", n2);
/* close */
isclose(db);
return 0;
}
Required:
Build and run with GCC:
gcc -m32 -I. test.c %GCBL%\lib\libvbisam.a -o test.exe
test
VMS comes with RMS API, which covers both index-sequential files and sequential files (plain text files).
The architecture looks like:
C does not support decimals and the file happens to contain decimals. This code use a hack to store the data in an integer with an implied decimal point. For real use a proper decimal library would be needed.
test.c:
/* standard C headers */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
/* RMS headers */
#include <starlet.h>
#include <rms.h>
/* read and write BCD - assume int is big enough */
static int READBCD(char *p, int n)
{
int i, upp, low;
int res = 0;
for(i = 0; i < n; i++)
{
upp = (p[i] & 0xF0) >> 4;
low = p[i] & 0x0F;
res = res * 10 + upp;
if(low <= 10)
{
res = res * 10 + low;
}
else
{
if(low == 11 | low == 13) res = -res;
}
}
return res;
}
static void WRITEBCD(int v, char *p, int n)
{
int i, upp, low;
int tmp = v;
for(i = n - 1; i >= 0; i--)
{
if(i == n - 1)
{
low = 0x0F; /* assume unsigned */
}
else
{
low = tmp % 10;
tmp = tmp / 10;
}
upp = tmp % 10;
tmp = tmp / 10;
p[i] = (upp << 4) | low;
}
}
/* data structure */
struct data
{
char id[8 + 1];
int iv;
int zv; /* implied 2 decimals */
double xv;
char sv[50 + 1];
};
static int length(struct data *d)
{
return 8 + 4 + 4 + 8 + 2 + strlen(d->sv);
}
static void serialize(struct data *d, char *buf)
{
short int slen = (short int)strlen(d->sv);
char *p = buf;
memcpy(p, &d->id[0], 8);
p += 8;
memcpy(p, &d->iv, 4);
p += 4;
WRITEBCD(d->zv, p, 4);
p += 4;
memcpy(p, &d->xv, 8);
p += 8;
memcpy(p, &slen, 2);
p += 2;
memcpy(p, &d->sv[0], slen);
}
static void deserialize(char *buf, struct data *d)
{
short int slen = 0;
char *p = buf;
memcpy(&d->id[0], p, 8);
p += 8;
memcpy(&d->iv, p, 4);
p += 4;
d->zv = READBCD(p, 4);
p += 4;
memcpy(&d->xv, p, 8);
p += 8;
memcpy(&slen, p, 2);
p += 2;
memcpy(&d->sv[0], p, slen);
d->sv[slen] = '\0';
}
#define KEYSIZ 8
#define RECSIZ KEYSIZ + 4 + 4 + 8 + 2 + 50
/* error handling functions */
void rms_exit(long stat)
{
printf("Error code: %d\n", stat);
exit(1);
}
static void dump(struct RAB *rab, char *id)
{
char buf[100];
long stat;
struct data d;
printf("Key=%s\n", id);
rab->rab$l_kbf = id;
rab->rab$b_ksz = KEYSIZ;
rab->rab$b_krf = 0;
rab->rab$l_rop = 0;
rab->rab$l_ubf = buf;
rab->rab$w_usz = sizeof(buf);
stat = sys$get(rab, 0, 0);
if(stat & 1) {
deserialize(buf, &d);
printf("(%d,%d.%02d,%f,%s)\n", d.iv, d.zv / 100, d.zv % 100, d.xv, d.sv);
} else {
printf("Not found\n");
}
}
static const char *FNM = "testdb.isq";
static const int NREC = 1000;
static const int C_OFFSET = 2 * NREC;
int main()
{
char buf[100];
long stat;
struct FAB fab;
struct RAB rab;
struct XABKEY xab;
char id[KEYSIZ + 1], startid[KEYSIZ + 1], stopid[KEYSIZ + 1];
struct data d;
int n, n2;
/* open */
fab = cc$rms_fab;
fab.fab$l_fna = (char *)FNM;
fab.fab$b_fns = strlen(FNM);
fab.fab$b_org = FAB$C_IDX;
fab.fab$b_rfm = FAB$C_FIX;
fab.fab$b_rat = FAB$M_CR;
fab.fab$l_fop = FAB$M_CIF;
fab.fab$w_mrs = RECSIZ;
fab.fab$b_fac = FAB$M_GET | FAB$M_PUT | FAB$M_UPD | FAB$M_DEL;
fab.fab$l_xab = (char *)&xab;
xab = cc$rms_xabkey;
xab.xab$b_dtp = XAB$C_STG;
xab.xab$w_pos0 = 0;
xab.xab$b_ref = 0;
xab.xab$b_siz0 = KEYSIZ;
stat = sys$create(&fab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
fab.fab$l_xab = 0;
rab = cc$rms_rab;
rab.rab$l_fab = &fab;
rab.rab$b_rac = RAB$C_KEY;
stat = sys$connect(&rab, 0 ,0);
if(!(stat & 1)) {
rms_exit(stat);
}
/* put data */
for(int i = 0; i < NREC; i++)
{
sprintf(id, "Key#%d", C_OFFSET + i + 1);
memcpy(d.id, id, KEYSIZ);
d.iv = i + 1;
d.zv = (i + 1) * 100;
d.xv = i + 1.0;
sprintf(d.sv, "This is value %d", i + 1);
serialize(&d, buf);
rab.rab$l_rbf = buf;
rab.rab$w_rsz = RECSIZ;
stat = sys$put(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
}
/* */
sprintf(id, "Key#%d", C_OFFSET + 77);
/* get */
dump(&rab, id);
/* delete */
rab.rab$l_kbf = id;
rab.rab$b_ksz = KEYSIZ;
rab.rab$b_krf = 0;
rab.rab$l_rop = RAB$M_KGE;
stat = sys$find(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
stat = sys$delete(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
/* get non existing */
dump(&rab, id);
/* */
sprintf(id, "Key#%d", C_OFFSET + 88);
/* update and get */
dump(&rab, id);
rab.rab$l_kbf = id;
rab.rab$b_ksz = KEYSIZ;
rab.rab$b_krf = 0;
rab.rab$l_rop = 0;
rab.rab$l_ubf = buf;
rab.rab$w_usz = sizeof(buf);
stat = sys$get(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
deserialize(buf, &d);
d.iv = d.iv + 1;
d.zv = d.zv + 10;
d.xv = d.xv + 0.1;
strcat(d.sv, " updated");
serialize(&d, buf);
rab.rab$l_rbf = buf;
rab.rab$w_rsz = RECSIZ;
stat = sys$update(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
dump(&rab, id);
/* list all */
n = 0;
stat = sys$rewind(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
rab.rab$b_rac = RAB$C_SEQ; /* switch to sequential access mode */
for(;;)
{
rab.rab$l_kbf = 0;
rab.rab$b_ksz = 0;
rab.rab$b_krf = 0;
rab.rab$l_rop = 0;
rab.rab$l_ubf = buf;
rab.rab$w_usz = sizeof(buf);
stat = sys$get(&rab, 0, 0);
if(!(stat & 1)) break;
deserialize(buf, &d);
if(strstr(d.id, "Key#") != d.id)
{
printf("Unexpected key: %s\n", d.id);
}
if(d.iv < 1 || NREC < d.iv || d.zv < 100 || NREC * 100 < d.zv || d.xv < 1 || NREC < d.xv)
{
printf("Unexpected value: (%d,%f,%s)\n", d.iv, d.xv, d.sv);
}
n++;
}
rab.rab$b_rac = RAB$C_KEY; /* switch back to keyed access mode */
printf("%d\n", n);
/* list keys where "Key#n075" <= key < "Key#n085" */
sprintf(startid, "Key#%d", C_OFFSET + 75);
sprintf(stopid, "Key#%d", C_OFFSET + 85);
rab.rab$l_kbf = startid;
rab.rab$b_ksz = KEYSIZ;
rab.rab$b_krf = 0;
rab.rab$l_rop = RAB$M_KGE;
stat = sys$find(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
n2 = 0;
rab.rab$b_rac = RAB$C_SEQ; /* switch to sequential access mode */
for(;;)
{
rab.rab$l_kbf = 0;
rab.rab$b_ksz = 0;
rab.rab$b_krf = 0;
rab.rab$l_rop = 0;
rab.rab$l_ubf = buf;
rab.rab$w_usz = sizeof(buf);
stat = sys$get(&rab, 0, 0);
if(!(stat & 1)) break;
deserialize(buf, &d);
if(strcmp(d.id, stopid) >= 0) break;
n2++;
}
rab.rab$b_rac = RAB$C_KEY; /* switch back to keyed access mode */
printf("%d\n", n2);
/* close */
stat = sys$disconnect(&rab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
stat = sys$close(&fab, 0, 0);
if(!(stat & 1)) {
rms_exit(stat);
}
return 0;
}
Required:
Build and run:
$ cc test
$ link test
$ run test
VMS Python comes with an IndexedFile module capable of accessing index-sequential files and a construct module capable of mapping between a native record format and Python data objects.
test.py:
from construct import *
from vms.rms.IndexedFile import IndexedFile
from decimal import *
from extras import *
class Data:
def __init__(self, id, iv, zv, xv, sv):
self.id = id
self.iv = iv
self.zv = zv
self.xv = xv
self.slen = len(sv.rstrip())
self.sv = sv.ljust(50)
def update_sv(self, sv):
self.slen = len(sv.rstrip())
self.sv = sv.ljust(50)
def __str__(self):
return '(%d, %.2f, %f, %s)' % (self.iv, self.zv, self.xv, self.sv.rstrip())
class DataFil(IndexedFile):
def __init__(self, fnm):
IndexedFile.__init__(self, fnm, Struct('data', String('id', 8), SNInt32('iv'), PackedDecimal('zv', 5, 2), VAXGFloat('xv'), UNInt16('slen'), String('sv', 50)))
def primary_keynum(self):
return 0
def pack_key(self, keynum, keyval):
return keyval
def keyval(self, rec, keynum):
return rec.id
def toData(obj):
return Data(obj.id, obj.iv, obj.zv, obj.xv, obj.sv)
def dump(db, id):
print('Key=%s' % (id))
d = db.fetch(0, id)
if d != None:
d = toData(d)
print(d)
else:
print('Not found')
NREC = 1000
PY_OFFSET = 6 * NREC
# open
db = DataFil('testdb.isq')
# put data
for i in range(NREC):
d = Data('Key#' + str(PY_OFFSET + i + 1), i + 1, Decimal(i + 1), i + 1.0, 'This is value %d' % (PY_OFFSET + i + 1))
db.put(d)
#
id = 'Key#' + str(PY_OFFSET + 77)
# get
dump(db, id)
# delete
db.delete(0, id)
# get non-existing
dump(db, id)
# get and update
id = 'Key#' + str(PY_OFFSET + 88)
dump(db, id)
d = db.fetch(0, id)
d = toData(d)
d.iv = d.iv + 1
d.zv = d.zv + Decimal('0.10')
d.xv = d.xv + 0.1
d.update_sv(d.sv[0:d.slen] + ' updated')
db.update(d)
dump(db, id)
# list all
n = 0
for d in db:
d = toData(d)
if not d.id.startswith('Key#'):
print('Unexpected key: ' + d.id)
if d.iv < 1 or NREC < d.iv or \
d.zv < 1 or NREC < d.zv or \
d.xv < 1 or NREC < d.xv:
if d.iv < 10:
print('Unexpected value: ' + str(d) + ' for id ' + str(d.id))
n = n + 1
print(n)
# list keys where "Key#n075" <= key < "Key#n085"
n2 = 0
for i in range(10): # hack - there should be a better way, but I can't find it
d = db.fetch(0, 'Key#' + str(PY_OFFSET + 75 + i))
if d != None:
d = toData(d)
n2 = n2 + 1
print(n2)
extras.py (with additions to construct moule for VAX floating point and packed decimals support):
from ctypes import CDLL, c_double, c_char_p, cast, byref
from construct import Adapter, Bytes
from vms.rms import BCD2Tuple, Tuple2BCD
from decimal import Decimal
CVT_K_VAX_F = 0
CVT_K_VAX_D = 1
CVT_K_VAX_G = 2
CVT_K_VAX_H = 3
CVT_K_IEEE_S = 4
CVT_K_IEEE_T = 5
CVT_K_IBM_LONG = 6
CVT_K_IBM_SHORT = 7
CVT_K_CRAY = 8
librtl = CDLL('LIBRTL.EXE')
lib_convert_float = getattr(librtl, 'CVT$CONVERT_FLOAT')
def float_to_python(val, typ):
res = c_double()
lib_convert_float(cast(val, c_char_p), typ, byref(res), CVT_K_IEEE_T, 0)
return res.value
def float_from_python(val, typ):
res = '12345678'
lib_convert_float(byref(c_double(val)), CVT_K_IEEE_T, cast(res, c_char_p), typ, 0)
return res
class VAXFFloatAdapter(Adapter):
def _decode(self, obj, context):
return float_to_python(obj, CVT_K_VAX_F)
def _encode(self, obj, context):
return float_from_python(obj, CVT_K_VAX_F)
def VAXFFloat(name):
return VAXFFloatAdapter(Bytes(name, 4))
class VAXDFloatAdapter(Adapter):
def _decode(self, obj, context):
return float_to_python(obj, CVT_K_VAX_D)
def _encode(self, obj, context):
return float_from_python(obj, CVT_K_VAX_D)
def VAXDFloat(name):
return VAXDFloatAdapter(Bytes(name, 8))
class VAXGFloatAdapter(Adapter):
def _decode(self, obj, context):
return float_to_python(obj, CVT_K_VAX_G)
def _encode(self, obj, context):
return float_from_python(obj, CVT_K_VAX_G)
def VAXGFloat(name):
return VAXGFloatAdapter(Bytes(name, 8))
class PackedDecimalAdapter(Adapter):
def __init__(self, byts, befdec, aftdec):
Adapter.__init__(self, byts)
self.befdec = befdec
self.aftdec = aftdec
def _decode(self, obj, context):
return Decimal(BCD2Tuple(obj, self.aftdec))
def _encode(self, obj, context):
return Tuple2BCD(obj.as_tuple(), self.befdec, self.aftdec)
def PackedDecimal(name, befdec, aftdec):
return PackedDecimalAdapter(Bytes(name, (befdec + aftdec + 2) / 2), befdec, aftdec)
Required:
Build and run:
$ python test.py
I have created an ISAM library that provides a lot of the standard functionality. It uses annotations to map the record and file format. It can be used by any JVM language (Java, Kotlin, Scala, Groovy, Jython, Rhino, Clojure etc.).
The architecture looks like:
There is no magic involved. It only works due to the fact that there is a plugin/driver for the underlying ISAM files.
Required for BDB:
Required for VBISAM:
Required for VMS:
First the mapping.
DataX.java:
import java.io.Serializable;
import java.math.BigDecimal;
import dk.vajhoej.isam.KeyField;
import dk.vajhoej.record.Alignment;
import dk.vajhoej.record.Endian;
import dk.vajhoej.record.ExtEndian;
import dk.vajhoej.record.FieldType;
import dk.vajhoej.record.Struct;
import dk.vajhoej.record.StructField;
@Struct(endianess=Endian.BIG, alignment=Alignment.ALIGN1)
public class DataX implements Serializable {
@KeyField(n=0)
@StructField(n=0, type=FieldType.FIXSTRNULTERM, length=8)
private String id;
@StructField(n=1, type=FieldType.INT4)
private int iv;
@StructField(n=2, type=FieldType.PACKEDBCD, length=4, decimals=2)
private BigDecimal zv;
@StructField(n=3, type=FieldType.FP8, endianess=ExtEndian.LITTLE)
private double xv;
@StructField(n=4, type=FieldType.VARFIXSTR, length=50)
private String sv;
public DataX() {
this("", 0, BigDecimal.ZERO, 0.0, "");
}
public DataX(String id, int iv, BigDecimal zv, double xv, String sv) {
super();
this.id = id;
this.iv = iv;
this.zv = zv;
this.xv = xv;
this.sv = sv;
}
public String getId() {
return id;
}
public int getIv() {
return iv;
}
public void setIv(int iv) {
this.iv = iv;
}
public BigDecimal getZv() {
return zv;
}
public void setZv(BigDecimal zv) {
this.zv = zv;
}
public double getXv() {
return xv;
}
public void setXv(double xv) {
this.xv = xv;
}
public String getSv() {
return sv;
}
public void setSv(String sv) {
this.sv = sv;
}
@Override
public String toString() {
return String.format("{iv: %d, zv: %s, xv: %f, sv: %s}", iv, zv, xv, sv);
}
}
The struct is defined as big endian as that is the default in GNU Cobol. But the Xv property get defined as little endian as floating point is actually stored like that in GNU Cobol.
I don't know why GNU Cobol is like that, but it is. And it is easy to map. And floating point are very rare in Cobol anyway.
import java.io.Serializable;
import java.math.BigDecimal;
import dk.vajhoej.isam.KeyField;
import dk.vajhoej.record.Alignment;
import dk.vajhoej.record.Endian;
import dk.vajhoej.record.FieldType;
import dk.vajhoej.record.Struct;
import dk.vajhoej.record.StructField;
@Struct(endianess=Endian.LITTLE, alignment=Alignment.ALIGN1)
public class DataX implements Serializable {
@KeyField(n=0)
@StructField(n=0, type=FieldType.FIXSTRNULTERM, length=8)
private String id;
@StructField(n=1, type=FieldType.INT4)
private int iv;
@StructField(n=2, type=FieldType.PACKEDBCD, length=4, decimals=2)
private BigDecimal zv;
@StructField(n=3, type=FieldType.VAXFP8) // we will use VAX G-floating
private double xv;
@StructField(n=4, type=FieldType.VARFIXSTR, length=50)
private String sv;
public DataX() {
this("", 0, BigDecimal.ZERO, 0.0, "");
}
public DataX(String id, int iv, BigDecimal zv, double xv, String sv) {
super();
this.id = id;
this.iv = iv;
this.zv = zv;
this.xv = xv;
this.sv = sv;
}
public String getId() {
return id;
}
public int getIv() {
return iv;
}
public void setIv(int iv) {
this.iv = iv;
}
public BigDecimal getZv() {
return zv;
}
public void setZv(BigDecimal zv) {
this.zv = zv;
}
public double getXv() {
return xv;
}
public void setXv(double xv) {
this.xv = xv;
}
public String getSv() {
return sv;
}
public void setSv(String sv) {
this.sv = sv;
}
@Override
public String toString() {
return String.format("{iv: %d, zv: %s, xv: %f, sv: %s}", iv, zv, xv, sv);
}
}
The struct is defined as little endian as that is what VMS use. And the floating point is defined as VAX G-floating not standard IEEE floating.
And now the program:
TestX.java:
import java.math.BigDecimal;
import dk.vajhoej.isam.IsamException;
import dk.vajhoej.isam.IsamResult;
import dk.vajhoej.isam.IsamSource;
import dk.vajhoej.isam.Key0;
import dk.vajhoej.isam.local.LocalIsamSource;
import dk.vajhoej.record.RecordException;
public class TestX {
private static void dump(IsamSource db, String id) throws IsamException, RecordException {
System.out.printf("Key=%s\n", id);
DataX d = db.read(DataX.class, new Key0<String>(id));
if(d != null) {
System.out.println(d);
} else {
System.out.println("Not found");
}
}
private static final int NREC = 1000;
private static final int JAVAX_OFFSET = 5 * NREC;
public static void main(String[] args) throws IsamException, RecordException {
try {
// open
// **** remove one comment **** // IsamSource db = new LocalIsamSource("testdb.isq", "dk.vajhoej.bdb.BDB", false);
// **** remove one comment **** // IsamSource db = new LocalIsamSource("testdb.isq", "dk.vajhoej.bdb.BDB", false);
// **** remove one comment **** // IsamSource db = new LocalIsamSource("testdb.isq", "dk.vajhoej.bdb.BDB", false);
// put data
for(int i = 0; i < NREC; i++) {
DataX d = new DataX("Key#" + (JAVAX_OFFSET + i + 1), i + 1, new BigDecimal(i + 1).setScale(2), i + 1.0, String.format("This is value %d", i + 1));
db.create(d);
}
//
DataX d;
String id;
id = "Key#" + (JAVAX_OFFSET + 77);
// get
dump(db, id);
// delete
db.delete(DataX.class, new Key0<String>(id));
// get non existing
dump(db, id);
// get and update
id = "Key#" + (JAVAX_OFFSET + 88);
dump(db, id);
d = db.read(DataX.class, new Key0<String>(id));
d.setIv(d.getIv() + 1);
d.setZv(d.getZv().add(new BigDecimal("0.10")));
d.setXv(d.getXv() + 0.1);
d.setSv(d.getSv() + " updated");
db.update(d);
dump(db, id);
// list all
IsamResult<DataX> it = db.readGE(DataX.class, new Key0<String>(" "));
int n = 0;
while(it.read()) {
d = it.current();
if(!d.getId().startsWith("Key#")) {
System.out.println("Unexpected key: " + d.getId());
}
if(d.getIv() < 1 || NREC < d.getIv() ||
d.getZv().compareTo(BigDecimal.ONE) < 0 || new BigDecimal(NREC).compareTo(d.getZv()) < 0 ||
d.getXv() < 1 || NREC < d.getXv()) {
System.out.println("Unexpected value: " + d);
}
n++;
}
System.out.println(n);
// list keys where "Key#n075" <= key < "Key#n085"
IsamResult<DataX> it2 = db.readGE(DataX.class, new Key0<String>("Key#" + (JAVAX_OFFSET + 75)));
int n2 = 0;
while(it2.read()) {
d = it2.current();
if(d.getId().compareTo("Key#" + (JAVAX_OFFSET + 85)) >= 0) break;
n2++;
}
System.out.println(n2);
// close
db.close();
} catch (Exception ex) {
ex.printStackTrace();
}
}
}
Build and run for BDB:
javac -cp %ISAM%\isam.jar;%REC%\record.jar TestX.java DataX.java
java -cp .;%ISAM%\isam.jar;%ISAM%\isam-bdb.jar;%REC%\record.jar;%BDB%\lang\java\db.jar TestX
Build and run for VBISAM:
unzip -o %ISAM%\isam-vbisam.zip
build
javac -cp %ISAM%\isam.jar;%REC%\record.jar TestX.java DataX.java
java -cp .;%ISAM%\isam.jar;%ISAM%\isam-vbisam.jar;%REC%\record.jar TestX
Build and run for VMS:
$ javac -classpath /isamdir/isam.jar:/isamdir/record.jar TestX.java DataX.java
$ java -classpath .:/isamdir/isam.jar:/isamdir/isam-vms.jar:/isamdir/record.jar "TestX"
testx.py:
from java.math import BigDecimal
from dk.vajhoej.isam import Key0
from dk.vajhoej.isam.local import LocalIsamSource
import DataX
def dump(db, id):
print('Key=%s' % (id))
d = db.read(DataX, Key0(id))
if d != None:
print(d)
else:
print('Not found')
NREC = 1000
PYX_OFFSET = 6 * NREC
# open
# **** remone one comment **** # db = LocalIsamSource('testdb.isq', 'dk.vajhoej.bdb.BDB', False)
# **** remone one comment **** # db = LocalIsamSource('testdb.isq', 'dk.vajhoej.vbisam.VBISAM', False)
# **** remone one comment **** # db = LocalIsamSource('testdb.isq', 'dk.vajhoej.vms.rms.IndexSequential', False)
# put data
for i in range(NREC):
d = DataX('Key#' + str(PYX_OFFSET + i + 1), i + 1, BigDecimal(i + 1), i + 1.0, 'This is value %d' % (i + 1))
db.create(d)
#
id = 'Key#' + str(PYX_OFFSET + 77)
# get
dump(db, id)
# delete
db.delete(DataX,Key0(id))
# get non-existing
dump(db, id)
# get and update
id = 'Key#' + str(PYX_OFFSET + 88)
dump(db, id)
d = db.read(DataX, Key0(id))
d.iv = d.iv + 1
d.zv = d.zv.add(BigDecimal('0.10'))
d.xv = d.xv + 0.1
d.sv = d.sv + ' updated'
db.update(d)
dump(db, id)
# list all
it = db.readGE(DataX, Key0(' '))
n = 0
while it.read():
d = it.current()
if not d.id.decode().startswith('Key#'):
print('Unexpected key: ' + str(d.id))
if d.iv < 1 or NREC < d.iv or \
d.zv.compareTo(BigDecimal.ONE) < 0 or BigDecimal(NREC).compareTo(d.zv) < 0 or \
d.xv < 1 or NREC < d.xv:
print('Unexpected value: ' + str(d))
n = n + 1
print(n)
# list keys where "Key#n075" <= key < "Key#n085"
it2 = db.readGE(DataX, Key0('Key#' + str(PYX_OFFSET + 75)))
n2 = 0
while it2.read():
d = it2.current()
if d.id >= ('Key#' + str(PYX_OFFSET + 85)):
break
n2 = n2 + 1
print(n2)
# close
db.close()
Build and run for BDB:
javac -cp %ISAM%\isam.jar;%REC%\record.jar DataX.java
java -cp %JYTHON%\jython.jar;.;%ISAM%\isam.jar;%ISAM%\isam-bdb.jar;%REC%\record.jar;%BDB%\lang\java\db.jar org.python.util.jython testx.py
Build and run for VBISAM:
unzip -o %ISAM%\isam-vbisam.zip
build
javac -cp %ISAM%\isam.jar;%REC%\record.jar DataX.java
java -cp %JYTHON%\jython.jar;.;%ISAM%\isam.jar;%ISAM%\isam-vbisam.jar;%REC%\record.jar org.python.util.jython testx.py
Build and run for VMS:
$ javac -classpath /isamdir/isam.jar:/isamdir/record.jar TestX.java DataX.java
$ define/nolog jython_libs "/isamdir/isam.jar:/isamdir/isam-vms.jar:/isamdir/record.jar"
$ jython testx.py
For Groovy we will not use DataX.java but define the class in Groovy.
testx.groovy:
import java.math.BigDecimal
import dk.vajhoej.isam.*
import dk.vajhoej.isam.local.*
import dk.vajhoej.record.*
@Struct(endianess=Endian.BIG, alignment=Alignment.ALIGN1)
class DataX {
@KeyField(n=0)
@StructField(n=0, type=FieldType.FIXSTRNULTERM, length=8)
String id = ""
@StructField(n=1, type=FieldType.INT4)
int iv = 0
@StructField(n=2, type=FieldType.PACKEDBCD, length=4, decimals=2)
BigDecimal zv = BigDecimal.ZERO
@StructField(n=3, type=FieldType.FP8, endianess=ExtEndian.LITTLE)
double xv = 0.0
@StructField(n=4, type=FieldType.VARFIXSTR, length=50)
String sv = ""
String toString() {
return String.format("{iv: %d, zv: %s, xv: %f, sv: %s}", iv, zv, xv, sv)
}
}
def dump(db, id) {
println("Key=$id")
d = db.read(DataX.class, new Key0<String>(id))
if(d != null) {
println(d)
} else {
println("Not found")
}
}
NREC = 1000
GROOVYX_OFFSET = 7 * NREC
// open
// **** remove one comment **** // db = new LocalIsamSource("testdb.isq", "dk.vajhoej.bdb.BDB", false)
// **** remove one comment **** // db = new LocalIsamSource("testdb.isq", "dk.vajhoej.vbisam.VBISAM", false)
// put
for(i in 1..NREC) {
d = new DataX(id: "Key#" + (GROOVYX_OFFSET + i), iv: i, zv: new BigDecimal(i).setScale(2), xv: i, sv: String.format("This is value %d", i))
db.create(d)
}
//
id = "Key#" + (GROOVYX_OFFSET + 77)
// get
dump(db, id)
// delete
db.delete(DataX.class, new Key0<String>(id))
// get non existing
dump(db, id)
// get and update
id = "Key#" + (GROOVYX_OFFSET + 88)
dump(db, id)
d = db.read(DataX.class, new Key0<String>(id))
d.iv = d.iv + 1
d.zv = d.zv.add(new BigDecimal("0.10"))
d.xv = d.xv + 0.1
d.sv = d.sv + " updated"
db.update(d)
dump(db, id)
// list all
it = db.readGE(DataX.class, new Key0<String>(" "))
n = 0
while(it.read()) {
d = it.current()
if(!d.id.startsWith("Key#")) {
println("Unexpected key: ${d.id}")
}
if(d.iv < 1 || NREC < d.iv || d.zv < 1 || NREC < d.zv || d.xv < 1 || NREC < d.xv) {
println("Unexpected value : $d")
}
n++
}
println(n)
// list keys where "Key#n075" <= key < "Key#n085"
it2 = db.readGE(DataX.class, new Key0<String>("Key#" + (GROOVYX_OFFSET + 75)))
n2 = 0
while(it2.read()) {
d = it2.current()
if(d.id >= "Key#" + (GROOVYX_OFFSET + 85)) break
n2++
}
println(n2)
// close
db.close()
Build and run for BDB:
groovy -cp "%ISAM%\isam.jar;%ISAM%\isam-bdb.jar;%REC%\record.jar;%BDB%\lang\java\db.jar" testx.groovy
Build and run for VBISAM:
unzip -o %ISAM%\isam-vbisam.zip
build
groovy -cp "%ISAM%\isam.jar;%ISAM%\isam-vbisam.jar;%REC%\record.jar" testx.groovy
testx.js:
importClass(Packages.java.lang.System);
importClass(Packages.java.math.BigDecimal);
function printf() {
System.out.printf.apply(System.out, arguments);
}
importClass(Packages.dk.vajhoej.isam.Key0);
importClass(Packages.dk.vajhoej.isam.local.LocalIsamSource);
importClass(Packages.DataX);
function dump(db, id) {
printf("Key=%s\n", id);
d = db.read(DataX, new Key0(id));
if(d != null) {
print(d);
} else {
print("Not found");
}
}
NREC = 1000;
JSX_OFFSET = 7 * NREC;
// open
db = new LocalIsamSource("testdb.isq", "dk.vajhoej.vms.rms.IndexSequential", false);
// put data
for(i = 0; i < NREC; i++) {
d = new DataX("Key#" + (JSX_OFFSET + i + 1), i + 1, new BigDecimal(i + 1), i + 1.0, "This is value " + (i + 1));
db.create(d);
}
//
id = "Key#" + (JSX_OFFSET + 77);
// get
dump(db, id);
// delete
db.delete(DataX, new Key0(id));
// get non-existing
dump(db, id);
// get and update
id = "Key#" + (JSX_OFFSET + 88);
dump(db, id);
d = db.read(DataX, new Key0(id));
d.iv = d.iv + 1;
d.zv = d.zv.add(new BigDecimal("0.10"))
d.xv = d.xv + 0.1;
d.sv = d.sv + " updated";
db.update(d);
dump(db, id);
// list all
it = db.readGE(DataX, new Key0(" "));
n = 0;
while(it.read()) {
d = it.current();
if(!d.id.startsWith("Key#")) {
print("Unexpected key: " + d.id);
}
if(d.iv < 1 || NREC < d.iv ||
d.zv.compareTo(BigDecimal.ONE) < 0 || new BigDecimal(NREC).compareTo(d.zv) < 0 ||
d.xv < 1 || NREC < d.xv) {
print("Unexpected value: " + d);
}
n = n + 1;
}
print(n);
// list keys where "Key#n075" <= key < "Key#n085"
it2 = db.readGE(DataX, Key0("Key#" + (JSX_OFFSET + 75)));
n2 = 0;
while(it2.read()) {
d = it2.current();
if(d.id >= ("Key#" + (JSX_OFFSET + 85))) break;
n2 = n2 + 1;
}
print(n2);
// close
db.close();
Build and run for VMS:
$ javac -classpath /isamdir/isam.jar:/isamdir/record.jar TestX.java DataX.java
$ define/nolog rhino_libs "/isamdir/isam.jar:/isamdir/isam-vms.jar:/isamdir/record.jar"
$ jsshell testx.js
For VMS index-sequential files there are an additional possibility as some other languages besides Cobol has bindings.
Pascal does not support decimals and the file happens to contain decimals. This code use a hack to store the data in an integer with an implied decimal point. For real use a proper decimal library would be needed.
test.pas:
program test(input, output);
label
finished;
const
NREC = 1000;
PAS_OFFSET = 3 * NREC;
type
pstring = varying [255] of char;
keystr = packed array [1..8] of char;
strdatalen = 0..65535;
strdata = packed array [1..50] of char;
nibble = 0..15;
decimal = packed array [1..8] of nibble;
data = packed record
id : [key(0),aligned(2)] keystr;
iv : integer;
zv : decimal;
xv : double;
slen : strdatalen;
sv : strdata;
end;
database = file of data;
function fromdecimal(v : decimal) : integer;
begin
fromdecimal := v[2] * 1000000 + v[1] * 100000 + v[4] * 10000 + v[3] * 1000 + v[6] * 100 + v[5] * 10 + v[8];
end;
function todecimal(v : integer) : decimal;
var
res : decimal;
begin
res[2] := v div 1000000;
res[1] := (v div 100000) mod 10;
res[4] := (v div 10000) mod 10;
res[3] := (v div 1000) mod 10;
res[6] := (v div 100) mod 10;
res[5] := (v div 10) mod 10;
res[8] := v mod 10;
res[7] := 12; (* assume positive/unsigned *)
todecimal := res;
end;
var
db : database; (* has to be global *)
i : integer;
procedure dump(id : keystr);
var
d : data;
temp : integer;
begin
writeln('Key=', id);
findk(db, 0, id);
if not ufb(db) then begin
d := db^;
temp := fromdecimal(d.zv);
writeln('(', d.iv:1, ',', (temp div 100):1, '.', dec(temp mod 100, 2), ',', d.xv:3:1, ',', substr(d.sv, 1, d.slen), ')');
end else begin
writeln('Not found');
end;
end;
var
d : data;
id : keystr;
n, n2, temp : integer;
begin
open(db, 'testdb.isq', unknown, organization := indexed, access_method := keyed);
(* put data *)
for i := 1 to NREC do begin
d.id := 'Key#' + dec(PAS_OFFSET + i, 4);
d.iv := i;
d.zv := todecimal(i * 100);
d.xv := i;
d.slen := 18;
d.sv := 'This is value ' + dec(i, 4);
db^ := d;
put(db);
end;
(* *)
id := 'Key#' + dec(PAS_OFFSET + 77, 4);
(* get *)
dump(id);
(* delete *)
findk(db, 0, id);
delete(db);
(* get non existing *)
dump(id);
(* *)
id := 'Key#' + dec(PAS_OFFSET + 88, 4);
(* update and get *)
dump(id);
findk(db, 0, id);
d := db^;
d.iv := d.iv + 1;
d.zv := todecimal(fromdecimal(d.zv) + 10);
d.xv := d.xv + 0.1;
d.slen := d.slen + 8;
d.sv := substr(d.sv, 1, d.slen - 8) + ' updated';
db^ := d;
update(db);
dump(id);
(* list all *)
resetk(db, 0);
n := 0;
while not eof(db) do begin
d := db^;
temp := fromdecimal(d.zv);
if (d.iv < 1) or (NREC < d.iv) or (temp < 100) or (NREC * 100 < temp) or (d.xv < 1) or (NREC < d.xv) then begin
writeln('Unepected value: ', '(', d.iv:1, ',', (temp div 100):1, '.', dec(temp mod 100, 2), ',', d.xv:3:1, ',', substr(d.sv, 1, d.slen), ')');
end;
n := n + 1;
get(db);
end;
writeln(n:1);
(* list keys where "Key#n075" <= key < "Key#n085" *)
findk(db, 0, 'Key#' + dec(PAS_OFFSET + 75, 4));
n2 := 0;
while not eof(db) do begin
d := db^;
if d.id >= ('Key#' + dec(PAS_OFFSET + 85, 4)) then goto finished;
n2 := n2 + 1;
get(db);
end;
finished:
writeln(n2:1);
(* *)
close(db);
end.
Build and run:
$ pascal test
$ link test
$ run test
test.bas:
program test
record datarec
string id = 8
long iv
decimal(7,2) zv
gfloat xv
word slen
string sv = 50
end record
declare integer constant NREC = 1000
declare integer constant BASIC_OFFSET = 4 * NREC
declare integer i, n, n2
declare string id0, idstart, idstop
map (databuf) datarec d
open "testdb.isq" as file #1, indexed fixed, recordtype list, map databuf, primary key d::id
! put
for i = 1 to NREC
d::id = format$(BASIC_OFFSET + i, "Key_#####")
d::iv = i
d::zv = i
d::xv = i
d::slen = 18
d::sv = format$(i, "This is value ####")
put #1
next i
!
id0 = format$(BASIC_OFFSET + 77, "Key_#####")
! get
gosub dump
! delete
find #1, key #0 eq id0
delete #1
! get non existing
gosub dump
!
id0 = format$(BASIC_OFFSET + 88, "Key_#####")
! update and get
gosub dump
get #1, key #0 eq id0
d::iv = d::iv + 1
d::zv = d::zv + 0.10
d::xv = d::xv + 0.1
d::slen = d::slen + 8
mid(d::sv,19,8) = " updated"
update #1
gosub dump
! list all
n = 0
reset #1
handler eof_handler
end handler
when error use eof_handler
while 1 = 1
get #1
if mid(d::id,1, 4) <> "Key#" then
print using "Unexpected key: 'E", d::id
end if
if d::iv < 1 or NREC < d::iv or d::zv < 1 or NREC < d::zv or d::xv < 1 or NREC < d::xv then
print using "Unexpected value: (####_,#####.##_,####.##_,'E)",d::iv,d::zv,d::xv,mid(d::sv,1,d::slen)
end if
n = n + 1
next
end when
print n
! list keys where "Key#n075" <= key < "Key#n085"
idstart = format$(BASIC_OFFSET + 75, "Key_#####")
idstop = format$(BASIC_OFFSET + 85, "Key_#####")
find #1, key #0 ge idstart
n2 = 0
when error use eof_handler
loop:
while 1 = 1
get #1
if d::id >= idstop then
exit loop
end if
n2 = n2 + 1
next
end when
print n2
!
close #1
exit program
dump:
print id0
handler notf_handler
print "Not found"
end handler
when error use notf_handler
get #1, key #0 eq id0
print using "(####_,#####.##_,####.##_,'E)",d::iv,d::zv,d::xv,mid(d::sv,1,d::slen)
end when
return
end program
Just like I am not experienced with Cobol then I am not experienced with Basic either, so the code above may not be optimal.
Build and run:
$ basic test
$ link test
$ run test
It can be relevant to compare lines of code for various technology combinations:
Technology | Lines of code |
---|---|
Cobol | 144 |
BDB and C | 375 |
BDB and C# | 258 |
BDB and Java | 174 + 55 |
VBISAM and C | 324 |
RMS and C | 308 |
ISAM library and Java | 82 + 57/56 |
ISAM library and Jython (JVM Python) | 55 + 57/56 |
ISAM library and Groovy | 86 |
ISAM library and Rhino (JVM JavaScript) | 76 + 56 |
VMS Pascal | 139 |
VMS Basic | 98 |
We see that:
Overall then the Cobol binding to indexed files is pretty good.
And it is certainly possible to accees such files from other languages if needed.
Version | Date | Description |
---|---|---|
1.0 | December 12th 2021 | Initial version |
1.1 | September 3rd 2022 | Add Python wrapper for VMS |
See list of all articles here
Please send comments to Arne Vajhøj