7.9 DECOMPRESS_RECORD | DECOMPRESS_RECORD2

DECOMPRESS_RECORD makes compressed update records easier to process and map. Typically, DECOMPRESS_RECORD is invoked before mapping a compressed update to trigger fetching of missing column values. COMPRESS_RECORD is called after processing the compressed updates.

In a C program, precede the INVOKE statement by the #pragma SQL CHAR_AS_ARRAY. Within this structure there may be one or more columns without any true values. Valid columns are indicated in the COLUMNS‐PRESENT array.

DECOMPRESS_RECORD is only valid for use with records that are less than 32767. DECOMPRESS_RECORD2 is valid for both these shorter records and the longer records defined with DDL2.

Syntax DECOMPRESS_RECORD

For C:

#include "usrdecs"
char     *compressed_rec;
short    compressed_len;
char     *decompressed_rec;
short    *columns_present;
short    source_or_target;
short    result;
result = DECOMPRESS_RECORD (compressed_rec, compressed_len, decompressed_rec,
                            columns_present, source_or_target);

For TAL:

?source usrdect
int result;
string .ext compressed_rec;
int    .ext compressed_len;
string .ext decompressed_rec;
int    .ext columns_present;
int     source_or_target; 
result := DECOMPRESS_RECORD (compressed_rec, compressed_len,
                         decompressed_rec, columns_present, source_or_target);

For COBOL:

?CONSULT =EXTRACT (or =REPLICAT)
01 compressed-rec         PIC X(32767).
01 compressed-len         PIC S9(4) COMP.
01 decompressed-rec       PIC X(32767).
01 columns-present.
  05 columns-present-flag PIC S9(4) COMP OCCURS 2000 TIMES.
01 source-or-target       PIC S9(4) COMP.
01 result                 PIC S9(4) COMP.
ENTER C "DECOMPRESS_RECORD" using compressed-rec, compressed-len,
          decompressed-rec, columns-present, source-or-target giving result.
columns_present
columns-present

An array of values that indicate the columns present in the compressed record. For example, if the first, third and sixth columns exist in the compressed record, and the total number of columns is seven, the array should contain 1,0,1,0,0,1,0. The number of columns in the table can be obtained by GET_NUM_COLUMNS. A column that is present but set to NULL should be indicated by a 1.

compressed_len
compressed-len

The length of the compressed record.

compressed_rec
compressed-rec

The record in compressed format. The size is allocated by the user up to the maximum of 32767.

decompressed_rec
decompressed-rec

The record returned in decompressed format. The size is allocated by the user up to the maximum of 32767

result

A code indicating whether the call was successful or not.

source_or_target
source-or-target

Represented by either EXIT‐FN‐SOURCE‐VAL or EXIT-FN-TARGET-VAL to indicate whether the record is a source or target record.

Syntax DECOMPRESS_RECORD2

For C:

#include "usrdecs"
char     *compressed_rec;
long     compressed_len;
char     *decompressed_rec;
short    *columns_present;
short    source_or_target;
short    result;
result = DECOMPRESS_RECORD2 (compressed_rec, compressed_len, decompressed_rec,
                            columns_present, source_or_target);

For TAL:

?source usrdect
int result;
string .ext compressed_rec;
int(32).ext compressed_len;
string .ext decompressed_rec;
int    .ext columns_present;
int     source_or_target; 
result := DECOMPRESS_RECORD2 (compressed_rec, compressed_len,
                         decompressed_rec, columns_present, source_or_target);

For COBOL:

?CONSULT =EXTRACT (or =REPLICAT)
01 compressed-rec         PIC X(128000).
01 compressed-len         PIC S9(8) COMP.
01 decompressed-rec       PIC X(128000).
01 columns-present.
  05 columns-present-flag PIC S9(4) COMP OCCURS 2000 TIMES.
01 source-or-target       PIC S9(4) COMP.
01 result                 PIC S9(4) COMP.
ENTER C "DECOMPRESS_RECORD2" using compressed-rec, compressed-len,
          decompressed-rec, columns-present, source-or-target giving result.
columns_present
columns-present

An array of values that indicate the columns present in the compressed record. For example, if the first, third and sixth columns exist in the compressed record, and the total number of columns is seven, the array should contain 1,0,1,0,0,1,0. The number of columns in the table can be obtained by GET_NUM_COLUMNS. A column that is present but set to NULL should be indicated by a 1.

compressed_len
compressed-len

The length of the compressed record.

compressed_rec
compressed-rec

The record in compressed format. Up to X(128000) can be allocated by the user as long as it is declared in extended storage.

decompressed_rec
decompressed-rec

The record returned in decompressed format. Up to X(128000) can be allocated by the user as long as it is declared in extended storage.

result

A code indicating whether the call was successful or not.

source_or_target
source-or-target

Represented by either EXIT‐FN‐SOURCE‐VAL or EXIT-FN-TARGET-VAL to indicate whether the record is a source or target record.