Manipulating Buffer Data
From MidrangeWiki
Summary
Have you ever needed to manipulate "field" data in a flat file or in a buffer—e.g. a trigger buffer—where the "fields" are not already broken out for you? Perhaps for fixed-length character data this was easy to do. But what about variable-length character data, with 2-byte or 4-byte length prefixes, and signed numeric data—e.g., negative binary data, negative packed data with decimals, or even negative zoned data with or without decimals?
This sample code demonstrates the use of three procedures to accomplish this (which you can even put the procedures into a service program—to make them more generally available across your shop). If you do put them into a service program, you will need to create the RPG prototypes for them. Simply copy the procedure interfaces given in order to create the associated prototypes.
By Dave Clark
Demo Program
This program simply demonstrates how you can call the two main procedures to get or put field data from or into a buffer—in this case, a data structure is used with subfields that represent the test data. But this was only for debugging purposes when I created the program. In a real case scenario, there would be no subfields and, perhaps, you would use information retrieved from SYSCOLUMNS to describe the field data you need.
**free
ctl-opt main(demopgm) dftactgrp(*no);
dcl-ds buffer len(1024);
b_char char(50);
b_bigint int(20);
b_integer int(10);
b_packed packed(11:2);
b_smallint int(5);
b_varchar2 varchar(256);
b_varchar4 varchar(256:4);
b_zoned zoned(11:2);
end-ds;
dcl-s pos packed(5:0);
dcl-s r_result varchar(50);
dcl-proc demopgm;
// build the buffer
pos = 1;
PutBufferPiece( buffer: 'This is a character string test.'
: 'C': pos: %size(b_char) );
pos += %size(b_char);
PutBufferPiece( buffer: %char(-9223372036854775807)
: 'B': pos: %size(b_bigint) );
pos += %size(b_bigint);
PutBufferPiece( buffer: %char(-2147483647)
: 'I': pos: %size(b_integer) );
pos += %size(b_integer);
PutBufferPiece( buffer: %char(-1234567.89)
: 'P': pos: %size(b_packed): %decpos(b_packed) );
pos += %size(b_packed);
PutBufferPiece( buffer: %char(-32767)
: 'S': pos: %size(b_smallint) );
pos += %size(b_smallint);
PutBufferPiece( buffer: 'This is a variable-character2 string test.'
: 'V': pos: %size(b_varchar2) );
pos += %size(b_varchar2);
PutBufferPiece( buffer: 'This is a variable-character4 string test.'
: 'V': pos: %size(b_varchar4): 4 );
pos += %size(b_varchar4);
PutBufferPiece( buffer: %char(-1234567.89)
: 'Z': pos: %size(b_zoned): %decpos(b_zoned) );
// now test the buffer
pos = 1;
r_result = GetBufferPiece( buffer: 'C': pos: %size(b_char) );
pos += %size(b_char);
r_result = GetBufferPiece( buffer: 'B': pos: %size(b_bigint) );
pos += %size(b_bigint);
r_result = GetBufferPiece( buffer: 'I': pos: %size(b_integer) );
pos += %size(b_integer);
r_result = GetBufferPiece( buffer: 'P': pos: %size(b_packed)
: %decpos(b_packed) );
pos += %size(b_packed);
r_result = GetBufferPiece( buffer: 'S': pos: %size(b_smallint) );
pos += %size(b_smallint);
r_result = GetBufferPiece( buffer: 'V': pos: %size(b_varchar2): 2 );
pos += %size(b_varchar2);
r_result = GetBufferPiece( buffer: 'V': pos: %size(b_varchar4): 4 );
pos += %size(b_varchar4);
r_result = GetBufferPiece( buffer: 'Z': pos: %size(b_zoned)
: %decpos(b_zoned) );
return;
end-proc;
Get Procedure
This procedure gets field data from the flat file record or from the buffer you specify. The result is always returned as a variable-length character string. But, in the case of numeric data, this is easily turned back into actual numbers via the use of the RPG/ILE %INT or %DEC built-in functions.
**free
ctl-opt NoMain DecPres(63);
//**********************************************************************
// This procedure will return a piece of a data buffer -- whether that
// piece is a character string, integer (binary numeric) data, packed
// numeric data, zoned numeric data, or variable-length character data.
// All types are returned as a variable length string with the numeric
// types converted from their buffer form to a (zoned) character string
// with leading sign. For data type, pass:
// C = character (default)
// B = big integer
// I = integer
// P = packed numeric (max 46 precision)
// S = small integer
// V = varchar (scale 4, or 2 by default)
// Z = zoned numeric (max 46 precision)
//**********************************************************************
dcl-proc GetBufferPiece export;
dcl-pi *n varchar(256);
string_buffer char(65536) options(*varsize);
piece_type char(1) const;
beg_byte_pos packed(5:0) const;
max_byte_len packed(3:0) const;
max_scale packed(2:0) const options(*nopass);
end-pi;
dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
packed_data packed(46:0) pos(1);
zoned_data zoned(46:0) pos(1);
bigint_data int(20) pos(1);
integer_data int(10) pos(1);
smallint_data int(5) pos(1);
end-ds;
dcl-c t_char 'C';
dcl-c t_bigint 'B';
dcl-c t_integer 'I';
dcl-c t_packed 'P';
dcl-c t_smallint 'S';
dcl-c t_varchar 'V';
dcl-c t_zoned 'Z';
dcl-s use_scale like(max_scale);
dcl-s d_shift packed(17:0);
if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null
or piece_type = t_varchar
and max_scale <> 4;
if piece_type = t_varchar;
use_scale = 2;
else;
use_scale = 0;
endif;
else;
use_scale = max_scale;
endif;
d_shift = %int(10 ** use_scale);
select;
when piece_type = t_bigint;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(bigint_data);
when piece_type = t_integer;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(integer_data);
when piece_type = t_packed;
packed_data = *zero;
%subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len)
= %subst(string_buffer:beg_byte_pos:max_byte_len);
return Dec2CharFormat(packed_data/d_shift:use_scale);
when piece_type = t_smallint;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(smallint_data);
when piece_type = t_varchar and use_scale = 2;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return varchar2_data;
when piece_type = t_varchar and use_scale = 4;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return varchar4_data;
when piece_type = t_zoned;
zoned_data = *zero;
%subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len)
= %subst(string_buffer:beg_byte_pos:max_byte_len);
return Dec2CharFormat(zoned_data/d_shift:use_scale);
endsl;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %subst(char_area:1:max_byte_len);
end-proc;
Dec2CharFmt Procedure
The Get Procedure, above, needed a little help with returning packed and zoned data—because of the variable number of decimal positions possible (since %DEC won't accept true variable values for the second and third parameters). This procedure takes care of that.
**free
ctl-opt NoMain DecPres(63);
//**********************************************************************
// This procedure formats the result of a numeric expression as a
// variable-length numeric character string with the maximum scale
// requested. (Precision can be up to 46 and scale up to 15.)
//**********************************************************************
dcl-proc Dec2CharFormat export;
dcl-pi *n varchar(50);
number_data zoned(46:15) const;
max_scale packed(2:0) const options(*nopass);
end-pi;
dcl-s use_scale like(max_scale);
if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null;
use_scale = 0;
else;
use_scale = max_scale;
endif;
select;
when use_scale = 15;
return %char(%dech(number_data:46:15));
when use_scale = 14;
return %char(%dech(number_data:46:14));
when use_scale = 13;
return %char(%dech(number_data:46:13));
when use_scale = 12;
return %char(%dech(number_data:46:12));
when use_scale = 11;
return %char(%dech(number_data:46:11));
when use_scale = 10;
return %char(%dech(number_data:46:10));
when use_scale = 9;
return %char(%dech(number_data:46:9));
when use_scale = 8;
return %char(%dech(number_data:46:8));
when use_scale = 7;
return %char(%dech(number_data:46:7));
when use_scale = 6;
return %char(%dech(number_data:46:6));
when use_scale = 5;
return %char(%dech(number_data:46:5));
when use_scale = 4;
return %char(%dech(number_data:46:4));
when use_scale = 3;
return %char(%dech(number_data:46:3));
when use_scale = 2;
return %char(%dech(number_data:46:2));
when use_scale = 1;
return %char(%dech(number_data:46:1));
endsl;
return %char(%dech(number_data:46:0));
end-proc;
Put Procedure
Now, occasionally, you might also have a need to put field data back into a flat file record or into a buffer—or to build one from scratch. This procedure will do that. Note that there is nothing returned from this procedure.
**free
ctl-opt NoMain DecPres(63);
//**********************************************************************
// This procedure will update a piece of a data buffer -- whether that
// piece is a character string, integer (binary numeric) data, packed
// numeric data, zoned numeric data, or variable-length character data.
// For data type, pass:
// C = character (default)
// B = big integer
// I = integer
// P = packed numeric (max 46 precision)
// S = small integer
// V = varchar (scale 4, or 2 by default)
// Z = zoned numeric (max 46 precision)
//**********************************************************************
dcl-proc PutBufferPiece export;
dcl-pi *n;
string_buffer char(65536) options(*varsize);
data_piece varchar(256) const;
piece_type char(1) const;
beg_byte_pos packed(5:0) const;
max_byte_len packed(3:0) const;
max_scale packed(2:0) const options(*nopass);
end-pi;
dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
packed_data packed(46:0) pos(1);
zoned_data zoned(46:0) pos(1);
bigint_data int(20) pos(1);
integer_data int(10) pos(1);
smallint_data int(5) pos(1);
end-ds;
dcl-c t_char 'C';
dcl-c t_bigint 'B';
dcl-c t_integer 'I';
dcl-c t_packed 'P';
dcl-c t_smallint 'S';
dcl-c t_varchar 'V';
dcl-c t_zoned 'Z';
dcl-s use_scale like(max_scale);
dcl-s d_shift packed(17:0);
if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null
or piece_type = t_varchar
and max_scale <> 4;
if piece_type = t_varchar;
use_scale = 2;
else;
use_scale = 0;
endif;
else;
use_scale = max_scale;
endif;
d_shift = %int(10 ** use_scale);
select;
when piece_type = t_bigint;
bigint_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_integer;
integer_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_packed;
packed_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len);
when piece_type = t_smallint;
smallint_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_varchar and use_scale = 2;
varchar2_data = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_varchar and use_scale = 4;
varchar4_data = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_zoned;
zoned_data = %int(%dec(data_piece:61:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len);
other;
char_area = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
endsl;
return;
end-proc;
