PRTLN Initial Commit
This commit is contained in:
SJLennon
@@ -0,0 +1,208 @@
|
||||
**free
|
||||
// ==============================================================
|
||||
// RPG demo of the PRT program: Printing a file format listing.
|
||||
// ==============================================================
|
||||
// - Uses SQL input from QSYS2.SYSCOLUMNS2 and QSYS.TABLES.
|
||||
// - Specify a single file or generic. Source files are omitted.
|
||||
// - Each file starts on a new page.
|
||||
// - Report is sorted by file and either field name or sequence.
|
||||
// Parms
|
||||
// 1 Library: Char 10.
|
||||
// 2 File name: Char 10.
|
||||
// For generic, append *, e.g., LINE* will print all
|
||||
// all files that start with LINE.
|
||||
// 3 Order Char(1)
|
||||
// N: sort by field name (default)
|
||||
// S: sort by ordinal sequence of fields
|
||||
// Sample call:
|
||||
// CALL PGM(DEMO_RPG1) PARM((LENNONS1) (BOMMASPF) (S))
|
||||
// If you plan to use this, creating a command is recommended.
|
||||
ctl-opt option(*srcstmt: *nodebugio)
|
||||
bnddir('SQL_BND')
|
||||
actgrp(*new) main(Main);
|
||||
/COPY copy_mbrs,prt_p
|
||||
/COPY copy_mbrs,srv_sql_p
|
||||
|
||||
dcl-proc Main;
|
||||
dcl-pi Main;
|
||||
pi_library char(10);
|
||||
pi_filelike char(10);
|
||||
pi_order char(1);
|
||||
end-pi;
|
||||
dcl-c SQLSUCCESS '00000';
|
||||
dcl-c SQLNODATA '02000';
|
||||
dcl-c SQLNOMOREDATA '02000';
|
||||
|
||||
dcl-s theLibrary varchar(10) ;
|
||||
dcl-s theFile varchar(10);
|
||||
dcl-s theSeq char(1) inz('N');
|
||||
dcl-s lastFile char(10) inz(' ');
|
||||
dcl-s eofSW ind inz(*off);
|
||||
|
||||
dcl-ds inSQL qualified ; // SQL data returned here
|
||||
library char(10);
|
||||
file char(10);
|
||||
file_desc char(50);
|
||||
field_name char(10);
|
||||
type char(8);
|
||||
length int(10);
|
||||
decimals int(10);
|
||||
field_desc char(50);
|
||||
col_head char(60);
|
||||
seq int(10);
|
||||
end-ds;
|
||||
|
||||
dcl-ds line len(132) qualified; // Line layout
|
||||
seq char(4);
|
||||
*n char(2);
|
||||
field_name char(10);
|
||||
*n char(2);
|
||||
type char(8);
|
||||
*n char(2);
|
||||
length char(10);
|
||||
*n char(2);
|
||||
decimal char(3);
|
||||
*n char(2);
|
||||
text char(50);
|
||||
end-ds;
|
||||
|
||||
dcl-ds h1 qualified; // Header 1
|
||||
*n char(15) inz('Field Listing: ');
|
||||
lib_file char(21);
|
||||
file_desc char(50);
|
||||
end-ds;
|
||||
|
||||
dcl-ds h2 likeds(line); // Header 2 layout.
|
||||
|
||||
exsr init;
|
||||
|
||||
// Set up second heading line
|
||||
h2.seq = ' Seq';
|
||||
h2.field_name = 'Field Name';
|
||||
h2.type = 'Type';
|
||||
h2.length = 'Length';
|
||||
h2.decimal = 'Dec';
|
||||
h2.text = 'Description';
|
||||
PRT(h2 : '*H2: S2');
|
||||
|
||||
// Underline second heading line
|
||||
h2.seq = *all'_';
|
||||
h2.field_name = *all'_';
|
||||
h2.type = *all'_';
|
||||
h2.length = *all'_';
|
||||
h2.decimal = *ALL'_';
|
||||
h2.text = *all'_';
|
||||
PRT(h2 : '*H3: S0');
|
||||
|
||||
// === Loop through the data and print lines
|
||||
// === Skip to new page if library changes
|
||||
exsr fetch;
|
||||
dow (eofSW = *off);
|
||||
if (inSQL.file <> lastFile);
|
||||
PRT(' ' : '*NEWPAGE');
|
||||
h1.lib_file = %trim(inSQL.library) + '/' + inSQL.file;
|
||||
h1.file_desc = inSQL.file_desc;
|
||||
PRT(h1 : '*H1: *P');
|
||||
lastFile = inSQL.file;
|
||||
endif;
|
||||
// Fill line with the rest of the data
|
||||
evalr line.seq = %trim(%char(inSQL.seq));
|
||||
line.field_name = inSQL.field_name;
|
||||
line.type = inSQL.type;
|
||||
evalr line.length = %trim(%char(inSQL.length));
|
||||
if (inSQL.decimals >=0);
|
||||
evalr line.decimal = %trim(%char(inSQL.decimals));
|
||||
else;
|
||||
line.decimal = ' ';
|
||||
endif;
|
||||
line.text = inSQL.field_desc;
|
||||
|
||||
PRT(line);
|
||||
exsr fetch;
|
||||
enddo;
|
||||
PRT(' ' : '*NEWPAGE');
|
||||
PRT('SQL parms: Library-' + theLibrary +
|
||||
' File-' + theFile + ' Order-' + theSeq: 'S2');
|
||||
PRT('** End of Report **' : 'S2');
|
||||
PRT(' ' : '*CLOSE');
|
||||
return;
|
||||
|
||||
// ==============================================================
|
||||
// === Initial Paramets and SQL setup ===========================
|
||||
begsr init;
|
||||
// === Process paramters
|
||||
if (%parms = 0); //no parms, set defaults for testing
|
||||
theLibrary = 'LENNONS1';
|
||||
theFile = 'ECL*';
|
||||
theSeq = 'S';
|
||||
endif;
|
||||
if (%parms = 1 ) ;
|
||||
theLibrary = %upper(%trim(pi_library));
|
||||
theFile = 'ECL*';
|
||||
theSeq = 'S';
|
||||
endif;
|
||||
if (%parms = 2);
|
||||
theLibrary = %upper(%trim(pi_library));
|
||||
theFile = %upper(%trim(pi_filelike));
|
||||
theSeq = 'S';
|
||||
endif;
|
||||
if (%parms = 3);
|
||||
theLibrary = %upper(%trim(pi_library));
|
||||
theFile = %upper(%trim(pi_filelike));
|
||||
theSeq = %upper(pi_order);
|
||||
endif;
|
||||
|
||||
// === Handle generic file
|
||||
theFile = %xlate('*' : '%' : theFile);
|
||||
|
||||
exec sql set option datfmt=*iso,
|
||||
closqlcsr=*endmod,
|
||||
commit=*none;
|
||||
|
||||
// === Cursor to get the data
|
||||
exec sql declare data_cursor cursor for
|
||||
SELECT TABLE_SCHEMA as library
|
||||
,cols.SYSTEM_TABLE_NAME AS file_name
|
||||
,char(tbls.TABLE_TEXT, 50) as file_desc
|
||||
,cols.SYSTEM_COLUMN_NAME AS field_name
|
||||
,char(cols.DATA_TYPE, 8) AS type
|
||||
,cols.LENGTH
|
||||
,cOALESCE(cols.NUMERIC_SCALE, -1) AS decimals
|
||||
,char(coalesce(cols.COLUMN_TEXT, ' '), 50) as field_desc
|
||||
,cHAR(COALESCE(cols.COLUMN_HEADING, ' '), 60) AS col_head
|
||||
,cols.ORDINAL_POSITION AS seq
|
||||
FROM QSYS2.SYSTABLES tbls
|
||||
JOIN QSYS2.SYSCOLUMNS2 cols
|
||||
using (TABLE_SCHEMA, TABLE_NAME)
|
||||
WHERE TABLE_SCHEMA = :theLibrary
|
||||
AND tbls.FILE_TYPE <> 'S' // omit source files
|
||||
AND trim(cols.SYSTEM_TABLE_NAME) like :theFile
|
||||
ORDER BY cols.SYSTEM_TABLE_NAME,
|
||||
case :theSeq
|
||||
when 'N' then cols.SYSTEM_COLUMN_NAME
|
||||
else digits(cols.ORDINAL_POSITION)
|
||||
end
|
||||
;
|
||||
//== Open cursor
|
||||
exec sql open data_cursor;
|
||||
if (sqlstate <> SQLSUCCESS);
|
||||
SQLProblem('Open failed');
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
// === Fetch next row from cursor ===============================
|
||||
begsr fetch;
|
||||
exec sql fetch data_cursor into :inSQL;
|
||||
if (sqlstate = SQLNOMOREDATA);
|
||||
eofSW = *on;
|
||||
leavesr;
|
||||
endif;
|
||||
if (sqlstate = SQLSUCCESS);
|
||||
eofSW = *off;
|
||||
leavesr;
|
||||
else;
|
||||
SQLProblem('Fetch failed');
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
end-proc main;
|
||||
Reference in New Issue
Block a user