! lis_to_spf.sqr ! $Source: /proj/www/WWW/sqr/RCS/lis_to_spf.sqr,v $ ! $Revision: 2.8 $ ! ! ! Copyright (C) 1998-2001 Ray Ontko & Co. ! http://www.ontko.com ! ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or ! (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! A copy of the GPL is available at the GNU web site: ! http://www.gnu.org/ ! http://www.gnu.org/copyleft/gpl.html ! ! ! ! INTRODUCTION to lis_to_spf.sqr ! ! The latest version of this program can always be downloaded ! from http://www.ontko.com/sqr/ . (This copy of the source was ! last checked into RCS on $Date: 2001/07/17 17:14:11 $.) ! ! ! You will probably need to modify this program in order to use ! it on your particular input files. The documentation below and ! throughout the code should help you do this. In particular, ! you'll probably need to add new layouts that match the files you ! are trying to convert, and you may need to alter or add an input ! file type. ! ! If you do make such modifications and think they might make a useful ! addition to the official version of this program, please send them to ! lis_to_spf@ontko.com . ! ! ! INSTRUCTIONS ! ! This program reads through an input file from the mainframe and properly ! interprets the special formatting codes. It currently handles both ! "ANSI carriage control" codes and certain printer control codes ! for some mainframe printer. (We're not sure exactly what printer model.) ! (Note that this program assumes the file is already converted from ! EBCIDIC to ASCII through some other method.) ! ! Output is done using normal "print" commands, so the output file ! name can be controlled using the "-f", "-printer:XX", "-keep" etc. ! SQR parameters. (Note that "-f" will be ignored if bursting by file ! or the "output=" parameter is used.) ! ! The program actually makes three passes through the input file. The first ! pass (reading up to the first {PREPROCESS_LINES} lines) attempts to ! determine the input file type (ANSI carriage, printer control ! codes, etc.). Using this information, the second pass ! converts the input file into a text file, keeping track of the maximum ! line width and page length. The program uses this information to choose ! a conversion page layout, which is used during the third pass (which ! actually reads from text file) during the actual conversion. ! ! The first line of a "text" file is treated specially. If it starts ! with an escape character (chr(27)), it is assumed to have printer ! initialization codes that should be stripped off. (The program does not ! attempt to handle printer control codes embedded inside the file, since ! at that point its not really a text file any more.) This will ! clear out printer init strings such as those generated for HP printers by ! PeopleSoft in setup0*.sqc. ! ! Compile options: ! -debug3 disable usage of SQR commands requiring v4.1 and above, ! allowing compliation using SQR v3 (and v4.0). ! This has the following side effects: ! * disables the TOC burst action ! * requires an Oracle login ("-xl" is not allowed) ! unless -debugd is also given ! -debugb blank TOC-entry: generate a blank TOC entry at the top of the ! TOC (assuming a TOC is generated), to work around the ! bug in some versions of SQR that makes the first ! entry use a different font than all the others. ! -debugd disable the date functions if -debug3 is choosen, ! allowing the program to compile without an Oracle ! login. (This option is ignored if -debug3 is ! not active.) ! -debugq will turn on "quiet" mode, suppressing most output. ! -debugs will add a small top-margin so that the first line on each ! page of the converted files can been seen in the SPF Viewer. ! (By default, the top-margin is 0 so that -printer:lp .lis files ! have no added blank lines.) ! -debugv will turn on "verbose" mode, producing extra output. ! ! ! Run time parameters: ! The first parameter given is the name of the input file. ! ! Following the input file name are zero or more run time options. ! ! The last parameter must be the word "go"; this is used to indicate ! the end of the run time options and causes the program to begin ! processing. ! ! Run time options are specified as option-name, value pairs, ! separated by '='. Option-names are not case sensitive; values ! may or may not be depending on the option. If an option controlling ! a setting is found more than once, the last value found is used. ! (Options controlling actions [e.g. "lts"] are performed each time ! the option is found.) ! ! Options of type "file" can contain zero or more parts; each part ! that is present overrides the defaults listed below: ! path: path of the input file ! filename: filename of the input file ! extension: each option has a default extension (which ! is the same as the option name unless otherwise ! mentioned below, or unless the related #define ! line is changed in this program) ! ! ! lts= file: "lis to spf" control file. A control file is a ! text file containing a list of options in "name=value" format ! (one option per line). Lines beginning with "!" are ignored ! (i.e. they are comments). The options are interpreted as if ! they were all found on the command line in place of the lts= ! option. (Note: lts files cannot include "lts=" options, but ! any number of lts= options can be included on the command line.) ! ! A line that starts with a '[' character defines a section. ! lis_to_spf will ignore lines within any section other than ! [lis_to_spf]. Lines that appear before any section name ! are assumed to be in an implied [lis_to_spf] section (which ! means the section line can be skipped if all the options ! are lis_to_spf options). ! ! ! tmptxt= file: the intermediate text file used during conversion. ! (Note: this option does not control whether the file is created; ! it only controls the file name used.) The default extension ! is ".tmp". ! ! outfile= file: the name of the output file. This replaces any value ! passed with the -f SQR option, but is itself ignored if ! the burst "file" action is used (in which case the parameter ! for that action determines the file names userd). (Note, ! however, that if the burst filename mask includes ~oX~ macros, ! the macro values will be calculated based on the filespec ! that results from processing the outfile= parameter.) ! ! Note that this parameter, like the other "file" parameters, ! is used to apply overrides against the *input* file name, ! not against the output file name that would have been used ! without the outfile= parameter. ! ! ! ifmt= string: Input format. Inputing this parameter allows lis_to_spf ! to skip the first "evaluation" pass through the input file. ! Currently supported values are: "text", "ansi", and "prt_xx". ! ! layout= string: Layout name. If entered, this parameter selects which ! layout to use for the SPF file (rather than having the ! program automatically determine the layout based on the ! line width and page length found during conversion). ! ! A layout of "none" will prevent the text-to-SPF step from ! running (leaving just the intermediate text file). ! ! date= string: "Active" Date. This overrides the system date as the ! "active" date (used in burst macro processing) (so that the ! burst files' filenames can have a different date, for example). ! The parameter should have the form ! date ; mask ! where "date" is the date and "mask" is an SQR date mask used ! to interprete "date". The "; " and mask are optional, ! and will default to SQR's default if not specified. ! ! skip= number: Pages to Skip. If entered, the first ! pages of the input file are skipped when writing the SPF file. ! (All pages are converted into the intermediate text file.) ! ! burst= string: Burst Description. A "burst description" has the ! following format: ! ! level, start_exp, end_exp, action [, parameters] ! ! An explanation of each field is found below: ! level: the level of the description, from 1 to ! {BURST_ARRAY_SIZE} - 1. Each burst must have a unique level. ! (If a level number is re-used, the original definition ! is replaced by the new one.) When a given level breaks, ! all the higher-numbered levels are also considered to ! have broken. ! ! start_exp: an expression that describes the beginning ! of the field in the report to examine in order to ! determine whether or not to take the action. Expression ! keywords (the word before the ":") are not case sensitive. ! Valid expressions are: ! rowcol:R C where R and C are row and column ! numbers on the page ! ! end_exp: an expression that describes how to find the end ! of the field. Expression keywords are not case ! sensitive. Valid expressions are: ! len:L where L is the number of characters to ! include in the field (starting with the ! character determined by the start_exp) ! ! action: what action to take when the value found in the ! field changes. Actions are not case sensitive. ! Valid actions are: ! file start a new file. The mask used to ! determine the name of the file must ! be passed in "parameters". ! ! toc table of contents. A TOC entry is ! written to the SPF file. The mask used ! to generate the entry text must be ! passed in "parameters". ! ! Only one level is allowed to have a toc ! entry. (This is an SQR limitation.) You ! can use the ~NNb~ macros to simulate ! a blank out higher-level field values ! when they are repeating.) ! ! show show the string on standard output ! (used mostly for debugging) ! ! none no action (used to define fields ! that are referenced at other levels). ! "parameters" is ignored. ! ! parameters: the contents of this field is used differently ! depending on the value of "action". (The field cannot ! contain any "=" or "," characters.) ! ! For "file", "toc", and "show", the field is used as a mask to ! determine the file name, TOC entry, or string to use ! for the page about to be written to the output file. ! All characters in the mask are used as-is except for ! the following "macros": ! ~~ "~" character ! ~.e~ "=" character ! ~.c~ "," character ! ! ~dMASK~ "active" date, formatted according to the ! given SQR date mask. (The "active" date ! is the system date unless overridden by ! the "date=" option.) If no mask is given, ! a default of YYYYMMDD is used ! ! ~i~ the full input filespec as entered on ! the command line ! ~ip~ path portion of input filespec ! ~in~ filename portion of input filespec ! ~ie~ extension portion of input filespec ! ! ~o~ the full output filespec, either as passed ! with -f on the SQR command line, or ! as specified by the "output=" parameter. ! ~op~ path portion of output filespec ! ~on~ filename portion of output filespec ! ~oe~ extension portion of output filespec ! ! ~$ENVVAR~ value of given environment variable ! ! ~1~ ~2~ ... current value of field from specified level ! ! ~1b~, ~2b~ ... current value of field from specified level ! if that level is breaking on this page, ! otherwise '' ! ! ~1B~, ~2B~ ... current value of field if that level is ! breaking, otherwise a string blanks of ! the same length as the field value ! ! These macros *are* case sensitive. (The character ! used to mark the macros is defined by {MACRO_CHAR}.) ! An unmatched ~ is left as-is (but note that if there ! are an odd number of ~s in the in the string, the last one ! will be the unmatched one). ! ! Notes: Bursting is done at the page level (text on a single page ! always gets handled together, and TOC entries always ! point to the top of a page). ! Fields on which bursting is performed must be contained ! within a single line of text. In order to control bursting ! using text on more than one line, multiple burst levels ! must be used. ! Bursting levels are roughly equivalent to SQR on-break ! levels, with the action being similar to a BEFORE= ! procedure. The burst processing is done all at once ! for each page, just before the page is printed to ! the SPF file. ! ! Sample usage: ! sqr lis_to_spf / -xl test.mdf go -ftest.lis -printer:lp ! produces a text version of test.mdf in test.lis ! ! sqr lis_to_spf / -xl test.mdf go -ftest.lis -nolis -debugs -keep ! produces an SPF file test.spf ! ! sqr lis_to_spf / -xl test.mdf go -ftest.htm -printer:ht -burst:p10 ! produces the various files needed to view this report in ! and html browser. (The "-burst:p" option is available in ! SQR v4.2 and later.) ! ! sqr lis_to_spf / -xl test.mdf skip=2 ifmt=ansi go -ftest.lis -printer:lp ! produces a text version of the ANSI file test.mdf (skipping ! the auto-detect of input format) in test.lis, with the ! first two (header) pages suppressed in the output ! ! sqr lis_to_spf / -xl test.mdf lts= go -ftest.lis -printer:lp ! reads the LTS file test.lts in the same directory as test.mdf ! ! sqr lis_to_spf / -xl test.mdf lts=../lts/ go -ftest.lis -printer:lp ! reads the LTS file test.lts in the ../lts/ directory ! ! ! sqr lis_to_spf login/passwd test.mdf lts= go -ftest.lis -printer:lp -debug3 ! Allows program to run under SQR3 while still allowing date ! processing under Oracle. ! ! sqr lis_to_spf / -xl test.mdf lts= go -ftest.lis -printer:lp -debug3n ! Allows program to run under SQR3 without a database login, but ! date processing is disabled. ! ! ! sqr lis_to_spf / -xl test.mdf "date=19990228;YYYYMMDD" lts= go -nolis -keep ! Sets the "active date" to February 2, 1999. (Note that ! the quotes are required in many operating systems because ";" ! is a special character.) Also keeps the .SPF file but ! suppresses generation of the "lis" file. ! ! Sample LTS files: ! (Because the bursting parameters tend to be long, the examples ! below use an LTS file, but it is possible to send them on the ! command line, within quotes, as shown above.) ! ! ifmt=text ! burst=1,rowcol:1 1, len: 5, file, ~on~_~1~~oe~ ! ! Assume the input file is in text format. Burst the file ! based on the five-character-long field at the upper-left-hand ! corner of each page. If the no-burst name of the output file ! would have been "test.lis" and the field in question ! contains numeric branch office codes, the then output files ! will be named similar to test_00000.lis, test_54321.lis, ! etc., based on the branch office codes found. ! ! ! burst=1,rowcol:1 1, len: 5, file, ~on~_~1~~oe~ ! burst=2,rowcol:2 1, len: 3, toc, Dept ~2~ ! If the input file contains branch office codes on the first line ! and department codes on line 2, this will produce ! files as described above, with a table of contents entry ! of each department within that file's branch. (This assumes ! at there is a page break between each department.) ! ! burst=1,rowcol:1 1, len:5, none ! burst=2,rowcol:2 1, len:3, toc, Branch ~1~ Dept ~2~ ! All the output will be sent into one file, but the ! table of contents will list both branch and department ! info. ! ! burst=1,rowcol:1 1, len:5, none ! burst=2,rowcol:2 1, len:3, toc, ~1B~ ~2~ ! The table of contents will show only the codes found, as ! follows: ! 00000 333 ! 345 ! 654 ! 54321 345 ! 789 ! ! ! WARNING: many files moved from a mainframe have NULL (ASCII code zero) ! characters in them, which SQR can not process; you'll need ! to be sure to remove these characters before trying to ! run the program. (If you notice that lines or parts of lines ! from the input file seem to be missing from your output file, ! you probably have a NULLs problem.) Since NULLs don't ! show up in a printout anyway, you won't loose anything ! by removing them. ! ! On Unix systems, an easy way to eliminate NULLs is using the ! "tr" command. For example, to simply delete these characters, ! you can use: ! ! tr -d "\000" < test.mdf > test.nonull ! ! . Or you can change them to some other character ("@" in ! this example) so that you can see where NULLs were found ! in your input file: ! ! tr "\000" "@" < test.mdf > test.nonull ! ! (After running these commands, you'd use test.nonull as the ! input file to lis_to_spf of course.) ! ! ! PLANNED IMPROVEMENTS ! ! Here are some changes we have in mind for future releases: ! * more flexible expressions for start_exp and end_exp in ! burst description ! * give LTS file name and line number for parameter error messages ! * support other databases (in addition to Oracle) for ! -debug3 mode. (Please send patches for your favorite ! database, since we don't have access to SQR for any ! other databases.) ! ! These are under consideration for inclusion and will be added if ! it turns out they'll actually be useful and feasable: ! * (?) allow cleaning of NULLs, EBCDIC-to-ASCII conversion ! * (?) allow LTS files to include other LTS files ! * (?) allow a default LTS file that would be used if the ! LTS= -specified file was not found. ! ! ! MODIFICATION HISTORY ! ! The latest version of this program can always be found in the ! Ray Ontko & Co. SQR library, http://www.ontko.com/sqr/sqrlib.html . ! ! ! $Log: lis_to_spf.sqr,v $ ! Revision 2.8 2001/07/17 17:14:11 nathant ! added #debugb flag to control blank toc-entry generation (later versions ! of SQR don't have the TOC font bug any more, so we don't always want ! to have the blank toc entry generated) ! ! Revision 2.8 2001/07/17 17:10:48 nathant ! added #debugb flag to control blank toc-entry generation (later versions ! of SQR don't have the TOC font bug any more, so we don't always want ! to have the blank toc enttry generated) ! ! Revision 2.7 2001/07/13 17:23:36 nathant ! expanded comments, fixed typos ! ! Revision 2.6 2001/02/08 16:54:08 nathant ! don't count lines starting with ^L when calculating page sizes ! ! Revision 2.5 2001/01/25 20:26:33 nathant ! added layout rpt225x88 ! ! Revision 2.4 2000/12/05 19:18:43 nathant ! added '1' as a "formfeed" character in prt_xx conversion. ! ! Revision 2.3 2000/12/05 19:10:15 nathant ! added TOC name to declare-toc; this is required in later versions ! of SQR. ! ! Revision 2.2 2000/12/05 18:12:00 nathant ! work around font problem on first entry of TOC. ! ! Revision 2.1 1999/03/24 23:02:48 nathant ! modified to avoid "YY date mask" warning with SQR 4.3 and above; ! strip off HP printer init codes from first line in text file; ! add 180x65 report size; ! removed trailing spaces from program source file. ! ! Revision 2.0 1999/02/05 17:57:57 nathant ! Added bursting (and supporting functions: macros, date processing, etc.) ! ! Revision 1.3 1998/12/19 02:10:39 nathant ! added run-time options and LTS file processing, ability to process ! input files already in text format. ! ! Revision 1.2 1998/12/16 05:13:34 nathant ! restructured to use intermediate text file. ! ! Revision 1.1 1998/12/08 15:19:03 nathant ! Initial revision ! #define TEXT_FILE_DEFAULT '.tmp' ! default mask for text file name #define LTS_FILE_DEFAULT '.lts' ! default mask for control files #define OUT_FILE_DEFAULT '.lis' ! default mask for output file #define MACRO_CHAR '~' ! character marking macros #define PREPROCESS_LINES 1000 #define MAX_RECLEN 1000 ! maximum record length on input files #define MAX_PAGE_LENGTH 90 ! maximum page length #define BURST_ARRAY_SIZE 6 ! one more than maximum number ! of burst/toc fields #define MAX_BURST_LEVEL {BURST_ARRAY_SIZE} - 1 #define INPUT 1 ! SQR file handle numbers #define OUTPUT 2 #define LTS 3 #define TRUE 1 #define FALSE 0 #define FORMFEED chr(12) #define MAX_CODES 256 ! number of codes to store in the codes array ! 256 = number of codes in a byte/character #define ERROR_WARNING 1 #define ERROR_ABORT 2 ! The lower-numbered formats have the highest-priority. (That is, when ! the program is auto-detecting the input type and more than one type ! matches the input file, the lowest-numbered one will be used.) ! "UNKNOWN" must be the last format. #define INPUTFORMAT_TEXT 0 #define INPUTFORMAT_ANSI 1 #define INPUTFORMAT_PRINTER_MODEL_XX 2 #define INPUTFORMAT_UNKNOWN 3 begin-setup ! ----------------------- Begin Layout definitions ! To add a new layout, you'll need to create declare-report and ! declare-layout sections, as well as HP and PS printer definitions ! if you need to alter the font size. Then search for the comment ! "ADD NEW LAYOUTS HERE" and add your new layout to the layout ! selection code found there. ! ! Note: the max-columns value should be one more than the "desired" ! width of the page so that SQR doesn't add line feeds when you ! print a full-width line. ! ----------------------- rpt85x66 declare-report rpt85x66 layout=rpt85x66 printer-type=hp end-declare declare-layout rpt85x66 #ifdef debugs top-margin=10 pt #else top-margin=0 #end-if bottom-margin=0 left-margin=0 max-columns=86 orientation=portrait end-declare ! ----------------------- rpt160x55 declare-report rpt160x55 layout=rpt160x55 printer-type=hp end-declare declare-layout rpt160x55 #ifdef debugs top-margin=10 pt #else top-margin=0 #end-if bottom-margin=0 left-margin=0 max-columns=161 orientation=landscape line-height=11 end-declare declare-printer rpt160x55_ps type=ps for-reports=(rpt160x55) point-size=8.2 end-declare declare-printer rpt160x55_hp type=hp for-reports=(rpt160x55) point-size=8.2 end-declare ! ----------------------- rpt160x65 declare-report rpt160x65 layout=rpt160x65 printer-type=hp end-declare declare-layout rpt160x65 #ifdef debugs top-margin=10 pt #else top-margin=0 #end-if bottom-margin=0 left-margin=0 max-columns=161 orientation=landscape line-height=9 end-declare declare-printer rpt160x65_ps type=ps for-reports=(rpt160x65) point-size=8.2 end-declare declare-printer rpt160x65_hp type=hp for-reports=(rpt160x65) point-size=8.2 end-declare ! ----------------------- rpt170x65 declare-report rpt170x65 layout=rpt170x65 printer-type=hp end-declare declare-layout rpt170x65 #ifdef debugs top-margin=10 pt #else top-margin=0 #end-if bottom-margin=0 left-margin=0 max-columns=171 orientation=landscape line-height=9 end-declare declare-printer rpt170x65_ps type=ps for-reports=(rpt170x65) point-size=7.0 end-declare declare-printer rpt170x65_hp type=hp for-reports=(rpt170x65) point-size=7.0 end-declare ! ----------------------- rpt180x65 declare-report rpt180x65 layout=rpt180x65 printer-type=hp end-declare declare-layout rpt180x65 #ifdef debugs top-margin=10 pt #else top-margin=0 #end-if bottom-margin=0 left-margin=0 max-columns=181 orientation=landscape line-height=9 end-declare declare-printer rpt180x65_ps type=ps for-reports=(rpt180x65) point-size=7.0 end-declare declare-printer rpt180x65_hp type=hp for-reports=(rpt180x65) point-size=7.0 end-declare ! ----------------------- rpt225x88 declare-report rpt225x88 layout=rpt225x88 printer-type=hp end-declare declare-layout rpt225x88 paper-size=(legal) #ifdef debugs top-margin=10 pt #else top-margin=0 #end-if left-margin=0 bottom-margin=0 max-columns=225 orientation=landscape line-height=6.5 end-declare declare-printer rpt225x88_ps type=ps for-reports=(rpt225x88) point-size=7.2 end-declare declare-printer rpt225x88_hp type=hp for-reports=(rpt225x88) point-size=7.2 end-declare ! ----------------------- End of Layout definitions #ifndef debug3 declare-toc toc for-reports=(all) end-declare declare-variable date $active_date end-declare #endif create-array name=inputformats size={INPUTFORMAT_UNKNOWN} field=name:char field=descr:char field=found:number={FALSE} create-array name=codes size={MAX_CODES} field=count:number=0 create-array name=page size={MAX_PAGE_LENGTH} field=line:char create-array name=burst_fields size={BURST_ARRAY_SIZE} field=start:char ! expression describing where ! this field starts on the page field=end:char ! where this field ends field=saved_value:char ! previous value found in this field field=current_value:char ! current value found in field field=action:char ! action to take when field value ! changes field=parameters:char ! parameters needed at burst time, ! such as filename template for ! output files #ifdef debug3 #ifndef debugd #if {SQR-DATABASE} = 'ORACLE' begin-sql alter session set nls_date_format = 'DD-MON-YYYY' end-sql #endif #endif #endif end-setup begin-program do initialize do get_parameters if #input_file_type = {INPUTFORMAT_UNKNOWN} do determine_input_file_type end-if do convert_to_text if $layout_selected <> 'none' do text_to_spf end-if end-program ! -------------------------------------------------------------------- begin-procedure initialize ! Load the "for-the-user" names for each possible input format. put 'text' 'Text' into inputformats ({INPUTFORMAT_TEXT}) name descr put 'ansi' 'ANSI Control Codes' into inputformats ({INPUTFORMAT_ANSI}) name descr put 'prt_xx' 'Printer Control Codes' into inputformats ({INPUTFORMAT_PRINTER_MODEL_XX}) name descr move 0 to #skip_past_page move {INPUTFORMAT_UNKNOWN} to #input_file_type move '' to $layout_selected move 0 to #highest_burst_level move $sqr-report to $initial_report_filespec #ifndef debug3 ! use V4 feature ! SQR for Oracle seems to be the only port that has two-digit ! years in the default date edit mask. We'll make sure we are ! using four-digit years.... #if {SQR-DATABASE} = 'ORACLE' alter-locale date-edit-mask='DD-MON-YYYY' #endif move $current-date to $active_date #else #ifndef debugd ! emulate V4 feature in V3; requires database login in SQR for Oracle V3 do date_to_native('','', $active_date) #else ! date functions are not available; set invalid date move '' to $active_date #end-if #endif end-procedure ! initialize ! -------------------------------------------------------------------- begin-procedure get_parameters move '' to $text_file_override move '' to $out_file_override ! get the file to be converted input $input_filespec 'Input file name' ! get any options move {TRUE} to #need_input while #need_input input $input 'Option ("name=value") or "GO"' if lower($input) != 'go' do process_option($input) else move {FALSE} to #need_input end-if end-while #ifndef debugq #ifdef debug3 show 'Using active date: ' $active_date #else show 'Using active date: ' $active_date DATE #endif show show #endif do apply_filespec_override({TEXT_FILE_DEFAULT}, $text_file_override, $text_file_override) do apply_filespec_override($input_filespec, $text_file_override, $text_filespec) if $out_file_override <> '' ! if no "outfile" parameter was specified, we use the ! initial_report_filespec (which is based on the -f parameter ! passed on the SQR command line.) If one was specified, then we ! use it to mask the input file name in order to override the ! initial_report_filespec. do apply_filespec_override({OUT_FILE_DEFAULT}, $out_file_override, $out_file_override) do apply_filespec_override($input_filespec, $out_file_override, $initial_report_filespec) end-if end-procedure ! get_parameters ! -------------------------------------------------------------------- begin-procedure process_option($parameter) unstring $parameter by '=' into $name $value let $name=rtrim(ltrim(lower($name),' '),' ') let $value=rtrim(ltrim($value,' '),' ') evaluate $name when='burst' unstring $value by ',' into $level $start $end $action $parameters ! level must be between 1 and {MAX_BURST_LEVEL} let #level = trunc(to_number($level),0) if #level = 0 let $message = 'Invalid level "' || $level || '" specified in "burst=' || $value || '".' do error($message, {ERROR_ABORT}) end-if if #level > {MAX_BURST_LEVEL} let $message = 'Level "' || $level || '" specified in "burst=' || $value || '" exceeds maximum level, ' || to_char({MAX_BURST_LEVEL}) || '.' do error($message, {ERROR_ABORT}) end-if if #level > #_highest_burst_level move #level to #_highest_burst_level end-if let $start=rtrim(ltrim($start, ' '), ' ') let $end=rtrim(ltrim($end, ' '), ' ') let $action=rtrim(ltrim($action, ' '), ' ') let $parameters=rtrim(ltrim($parameters, ' '), ' ') put $start $end $action $parameters into burst_fields (#level) start end action parameters #ifdef debugv show 'Burst ' #level edit 999 ' start ' $start ' end ' $end ' action ' $action ' parameters ' $parameters #endif break when='date' unstring $value by ';' into $newdate $dateformat let $newdate = ltrim(rtrim($newdate,' '),' ') let $dateformat = ltrim(rtrim($dateformat,' '),' ') #ifndef debug3 ! use V4 commands let $_active_date = strtodate($newdate, $dateformat) #else #ifndef debugd ! emulate V4 command in V3 do date_to_native($newdate, $dateformat, $_active_date) #else let $message = 'Date functions disabled by -debug3 and -debugd ' || '(but ' || $name || '= option found).' do error($message, {ERROR_ABORT}) #end-if #end-if break when='lts' do apply_filespec_override({LTS_FILE_DEFAULT}, $value, $lts_file_override) do apply_filespec_override($_input_filespec, $lts_file_override, $lts_filespec) do process_option_file($lts_filespec) break when='tmptxt' move $value to $_text_file_override break when='outfile' move $value to $_out_file_override break when='ifmt' lowercase $value move 0 to #i while #i < {INPUTFORMAT_UNKNOWN} if $value = inputformats.name(#i) break end-if add 1 to #i end-while move #i to #_input_file_type if #i = {INPUTFORMAT_UNKNOWN} let $message = 'Unknown input format type "' || $value || '" specified.' do error($message, {ERROR_ABORT}) end-if #ifndef debugq get $input_type from inputformats (#i) descr show 'Input format specified: ' $input_type #endif break when='layout' move $value to $_layout_selected #ifndef debugq show 'Layout specified: ' $value #endif break when='skip' move $value to #temp if #temp = 0 let $message = 'Skip value "' || $value || '" is invalid (must be a number greater than 0).' do error($message, {ERROR_WARNING}) else move #temp to #_skip_past_page end-if when-other if $name = rtrim(ltrim(lower($parameter),' '),' ') let $message = 'Invalid option format (no "="): "' || $parameter || '"' do error($message, {ERROR_ABORT}) else let $message = 'Ignoring unknown option "' || $name || '" (value="' || $value || '" ).' do error($message, {ERROR_WARNING}) end-if break end-evaluate end-procedure ! process_option ! -------------------------------------------------------------------- ! This procedure reads through an lts file and processes each parameter ! line. begin-procedure process_option_file($lts_filespec) move {TRUE} to #in_lis_to_spf_section open $lts_filespec as {LTS} for-reading record={MAX_RECLEN}:vary #ifdef debugv show 'Reading LTS file "' $lts_filespec '".' #endif while 1 read {LTS} into $line:{MAX_RECLEN} if #_end-file break end-if let $line = ltrim($line,' ') let $firstchar = substr($line,1,1) evaluate $firstchar when = '' when = '!!' ! ignore blank lines and comments break when = '[' if ltrim(rtrim($line,'] '), '[ ') = 'lis_to_spf' move {TRUE} to #in_lis_to_spf_section else move {FALSE} to #in_lis_to_spf_section end-if break when-other if #in_lis_to_spf_section do process_option($line) end-if break end-evaluate end-while close {LTS} end-procedure ! process_option_file ! -------------------------------------------------------------------- ! This procedure reads through the input file and attempts to determine ! what format it is in (text, ansi carriage control, etc.). The lowest- ! numbered format (as defined by the inputformat array) for which the ! control codes match the input file is used. (This procedure can be ! bypassed by using the ifmt= parameter.) begin-procedure determine_input_file_type open $input_filespec as {INPUT} for-reading record={MAX_RECLEN}:vary #ifndef debugq show 'File: ' $input_filespec show 'Determining file type....' #endif move 0 to #line_count while #line_count < {PREPROCESS_LINES} read {INPUT} into $line:{MAX_RECLEN} if #end-file break end-if add 1 to #line_count if $line = '' move {TRUE} to #empty_line add 1 to #empty_line_count else move {FALSE} to #empty_line let $code = substr($line,1,1) let $line = substr($line,2,{MAX_RECLEN}) let #code = ascii( $code ) do num_to_hex(#code,2,$hex) if $code = {FORMFEED} put {TRUE} into inputformats ({INPUTFORMAT_TEXT}) found end-if evaluate $code WHEN=' ' WHEN='0' WHEN='-' WHEN='+' WHEN='1' put {TRUE} into inputformats ({INPUTFORMAT_ANSI}) found break end-evaluate evaluate $hex WHEN='01' WHEN='0D' WHEN='11' WHEN='19' WHEN='69' WHEN='8D' WHEN='BB' put {TRUE} into inputformats ({INPUTFORMAT_PRINTER_MODEL_XX}) found break end-evaluate end-if end-while close {INPUT} if #line_count = 0 do error('Input file is empty.', {ERROR_ABORT}) end-if move 0 to #i while #i < {INPUTFORMAT_UNKNOWN} if inputformats.found(#i) move #i to #input_file_type break end-if add 1 to #i end-while if #input_file_type = {INPUTFORMAT_UNKNOWN} do error('Unrecognized input file format.',{ERROR_ABORT}) end-if #ifndef debugq get $input_type from inputformats (#input_file_type) descr show 'Lines examined: ' #line_count edit 888888 show 'Input format detected: ' $input_type show #endif end-procedure ! determine_input_file_type ! -------------------------------------------------------------------- begin-procedure convert_to_text ! If the input type is text and the user selected a layout, we don't ! need to do anything here. (Otherwise, we need to convert to text, or ! at least get infomation from the file to use in selecting a layout.) if not (#input_file_type = {INPUTFORMAT_TEXT} and $layout_selected <> '') move 0 to #line_count move 0 to #max_line_width move 0 to #max_page_length move 0 to #empty_line_count move 0 to #page_pos move 0 to #page_count if #input_file_type = {INPUTFORMAT_TEXT} #ifndef debugq show 'Examining text-format input file....' #endif move $input_filespec to $text_filespec else if $input_filespec = $text_filespec do error('Intermediate text file is the same as the input file.', {ERROR_ABORT}) end-if open $text_filespec as {OUTPUT} for-writing record={MAX_RECLEN}:vary #ifndef debugq show 'Converting to text file "' $text_filespec '" ....' #endif end-if open $input_filespec as {INPUT} for-reading record={MAX_RECLEN}:vary evaluate #input_file_type when = {INPUTFORMAT_TEXT} do get_text_file_info break when = {INPUTFORMAT_ANSI} do convert_to_text_from_ansi break when = {INPUTFORMAT_PRINTER_MODEL_XX} do convert_to_text_from_printer_model_xx break end-evaluate close {INPUT} if #input_file_type <> {INPUTFORMAT_TEXT} close {OUTPUT} #ifndef debugq show 'Lines processed: ' #line_count edit 999,999 show show 'Control codes found:' show 'Code Hex Ascii Count' move 0 to #i while #i < {MAX_CODES} get #count from codes(#i) count if #count > 0 do generate_code_info( #i, $info) show $info ' ' #count edit 999,999 end-if add 1 to #i end-while #endif end-if #ifndef debugq show 'Lines processed: ' #line_count edit 999,999 show show 'Max line width: ' #max_line_width edit 999,999 show 'Max page length: ' #max_page_length edit 999,999 show 'Empty lines found: ' #empty_line_count edit 999,999 show 'Page breaks: ' #page_count edit 999,999 #endif end-if ! if not (#input_file_type = {INPUTFORMAT_TEXT} and ! $layout_selected = '') end-procedure ! convert_to_text ! -------------------------------------------------------------------- begin-procedure get_text_file_info while 1 read {INPUT} into $line:{MAX_RECLEN} if #end-file break end-if add 1 to #line_count if $line = '' add 1 to #empty_line_count end-if if #line_count = 1 do remove_printer_codes($line) end-if let #ff_pos = instr($line, {FORMFEED}, 0) if #ff_pos > 0 ! there is a formfeed character in this line let $line2 = substr($line, #ff_pos + 1, {MAX_RECLEN}) let $line = substr($line, 1, #ff_pos - 1) if $line <> '' do process_line($line) end-if do process_page do process_line($line2) else ! no formfeed do process_line($line) end-if end-while do process_page end-procedure ! get_text_file_info begin-procedure process_line($line) add 1 to #_page_pos let #len = length($line) if #len > #_max_line_width move #len to #_max_line_width end-if end-procedure ! process_line begin-procedure process_page add 1 to #page_count if #page_pos > #max_page_length move #page_pos to #max_page_length end-if move 0 to #page_pos end-procedure ! process_page ! -------------------------------------------------------------------- ! This procedures reads an input file with ANSI control codes and ! outputs the intermediate text file. ! Since a control code of "+" indicates that we should over-write the ! previous line, we can't print a line until we read the following one. ! If a "+" line is found, the previous one is discarded. If a "+" ! line is found at the beginning of the input file, it will behave as ! if the code was a " " (since there is nothing to over-write). begin-procedure convert_to_text_from_ansi move {FALSE} to #form_feed_pending move {FALSE} to #line_saved move '' to $saved_line while 1 read {INPUT} into $line:{MAX_RECLEN} if #end-file break end-if add 1 to #line_count if $line = '' move {TRUE} to #empty_line add 1 to #empty_line_count else move {FALSE} to #empty_line let $code = substr($line,1,1) let $line = substr($line,2,{MAX_RECLEN}) let #code = ascii( $code ) end-if let #length = length( $line ) if substr($line,#length,1)=chr(13) subtract 1 from #length let $line = substr($line, 1, #length) end-if if #length > #max_line_width move #length to #max_line_width end-if if #empty_line ! assume the line consisted of spaces stripped off by the READ move ' ' to $code end-if if $code <> '+' and #line_saved if #form_feed_pending let $saved_line = {FORMFEED} || $saved_line move {FALSE} to #form_feed_pending end-if write {OUTPUT} from $saved_line move {FALSE} to #line_saved add 1 to #page_pos end-if evaluate $code when = ' ' ! move down one line move $line to $saved_line move {TRUE} to #line_saved break when = '0' ! move down two lines add 1 to #page_pos write {OUTPUT} from '' move $line to $saved_line move {TRUE} to #line_saved break when = '-' ! move down three lines add 2 to #page_pos write {OUTPUT} from '' write {OUTPUT} from '' move $line to $saved_line move {TRUE} to #line_saved break when = '+' ! stay on same line move $line to $saved_line move {TRUE} to #line_saved break when = '1' ! form feed ! we don't want a blank page at the beginning of the file if #page_pos > 0 or #page_count > 0 if #page_pos > #max_page_length move #page_pos to #max_page_length end-if move {TRUE} to #form_feed_pending move 0 to #page_pos add 1 to #page_count end-if move $line to $saved_line move {TRUE} to #line_saved break when-other do generate_code_info(#code, $info) let $message= 'Unknown ANSI control code:' || $info || '.' do error($message, {ERROR_ABORT}) end-evaluate if not #empty_line array-add 1 to codes (#code) count end-if end-while if #line_saved if #form_feed_pending let $saved_line = {FORMFEED} || $saved_line move {FALSE} to #form_feed_pending end-if write {OUTPUT} from $saved_line move {FALSE} to #line_saved add 1 to #page_pos end-if end-procedure ! convert_to_text_from_ansi ! -------------------------------------------------------------------- ! This procedure reads in an input file in the "printer" format and ! outputs the intermediate text file. ! For this input format, the printer codes at the beginning of the line ! affect the carriage motion *after* that line is printed, so we can ! always print the current line. Blank lines are printed as if they ! contained a "down one line" control code. begin-procedure convert_to_text_from_printer_model_xx move {FALSE} to #form_feed_pending while 1 read {INPUT} into $line:{MAX_RECLEN} if #end-file break end-if add 1 to #line_count if $line = '' move {TRUE} to #empty_line add 1 to #empty_line_count else move {FALSE} to #empty_line let $code = substr($line,1,1) let $line = substr($line,2,{MAX_RECLEN}) let #code = ascii( $code ) end-if let #length = length( $line ) if substr($line,#length,1)=chr(13) subtract 1 from #length let $line = substr($line, 1, #length) end-if if #length > #max_line_width move #length to #max_line_width end-if if #form_feed_pending let $line = {FORMFEED} || $line move {FALSE} to #form_feed_pending end-if write {OUTPUT} from $line add 1 to #page_pos if not #empty_line do num_to_hex(#code, 2, $hex) evaluate $hex when = '0D' when = '69' when = '8D' ! down 1 line break when = '01' when = '11' ! down 2 lines add 1 to #page_pos write {OUTPUT} from '' break when = '19' ! down 3 lines add 2 to #page_pos write {OUTPUT} from '' write {OUTPUT} from '' break when = 'BB' when = '31' ! form feed ! we don't want a blank page at the beginning of the file if #page_pos > 0 or #page_count > 0 if #page_pos > #max_page_length move #page_pos to #max_page_length end-if move {TRUE} to #form_feed_pending add 1 to #page_count move 0 to #page_pos end-if break when-other do generate_code_info(#code, $info) let $message = 'Unknown control code in ' || 'process_line_printer_model_xx :' || $info || '.' do error($message,{ERROR_ABORT}) end-evaluate array-add 1 to codes (#code) count end-if end-while end-procedure ! convert_to_text_from_printer_model_xx ! -------------------------------------------------------------------- begin-procedure text_to_spf #ifndef debugq show #endif if $layout_selected = '' #ifndef debugq show 'Auto-selecting layout.' #endif ! ADD NEW LAYOUTS HERE evaluate #max_line_width when <= 85 if #max_page_length > 66 let $message = 'Page length ' || edit(#max_page_length, '8888') || ' too long for defined layouts (max width <= 85).' do error($message,{ERROR_ABORT}) end-if move 'rpt85x66' to $layout_selected break when <= 160 evaluate #max_page_length when <= 55 move 'rpt160x55' to $layout_selected break when <= 65 move 'rpt160x65' to $layout_selected break when-other let $message = 'Page length ' || edit(#max_page_length, '8888') || ' too long for defined layouts (max width <= 160).' do error($message,{ERROR_ABORT}) break end-evaluate break when <= 170 evaluate #max_page_length when <= 65 move 'rpt170x65' to $layout_selected break when-other let $message = 'Page length ' || edit(#max_page_length, '8888') || ' too long for defined layouts (max width <= 170).' do error($message,{ERROR_ABORT}) break end-evaluate break when <= 180 evaluate #max_page_length when <= 65 move 'rpt180x65' to $layout_selected break when-other let $message = 'Page length ' || edit(#max_page_length, '8888') || ' too long for defined layouts (max width <= 180).' do error($message,{ERROR_ABORT}) break end-evaluate break when <= 225 evaluate #max_page_length when <= 88 move 'rpt225x88' to $layout_selected break when-other let $message = 'Page length ' || edit(#max_page_length, '8888') || ' too long for defined layouts (max width <= 225).' do error($message,{ERROR_ABORT}) break end-evaluate break when-other let $message= 'Line width ' || edit(#max_line_width, '8888') || ' too wide for output layouts.' do error($message, {ERROR_ABORT}) end-evaluate end-if ! When we execute "use-report", SQR changes the name of the report file ! to xxxx.SXX, where XX is a number which depends which declare-report ! section is selected. Since this program really outputs only one report, ! we want to change the new report name back to the name of the original ! report. (That way, -f on the SQR command line does what the user ! expects.) We do that with $initial_report_filespec (set in the ! initialize procedure) and the NEW-REPORT command below. (If file ! bursting is used, however, this will be overridden at burst time.) use-report $layout_selected new-report $initial_report_filespec open $text_filespec as {INPUT} for-reading record={MAX_RECLEN}:vary #ifndef debugq show 'Converting file to SPF (using layout "' $layout_selected '")....' #endif move 0 to #line_count move 1 to #current_line move 1 to #current_page move 0 to #skipped_pages #ifdef debugb move {FALSE} to #blank_toc_entry_generated #endif move 0 to #break_triggered_level ! all break actions should fire ! the first time through while 1 read {INPUT} into $line:{MAX_RECLEN} if #end-file break end-if add 1 to #line_count if #line_count = 1 do remove_printer_codes($line) end-if let #ff_pos = instr($line, {FORMFEED}, 0) if #ff_pos > 0 ! there is a formfeed character in this line let $line2 = substr($line, #ff_pos + 1, {MAX_RECLEN}) let $line = substr($line, 1, #ff_pos - 1) if $line <> '' do store_line($line) end-if do page_break do store_line($line2) else ! no formfeed do store_line($line) end-if end-while do page_break let #page_count = #current_page - 1 close {INPUT} #ifndef debugq show 'Lines processed: ' #line_count edit 999,999 show 'Pages generated: ' #page_count edit 999,999 show 'Pages skiped: ' #skipped_pages edit 999,999 show #endif end-procedure ! text_to_spf ! -------------------------------------------------------------------- begin-procedure store_line($line) put $line into page (#_current_line) line add 1 to #_current_line end-procedure ! store_line ! -------------------------------------------------------------------- begin-procedure page_break ! we ignore empty lines at the bottom of the page while page.line (#current_line) = '' and #current_line >= 1 subtract 1 from #current_line end-while ! if the page is empty we don't print it if #current_line > 0 if #skipped_pages < #skip_past_page add 1 to #skipped_pages #ifdef debugv show 'Skipping page ' #skipped_pages edit 99,999 ' ( ' #current_line edit 999 ' lines) ' #endif else ! #skipped_pages < #skip_past_page ! get field values from current page for any burst fields defined move 1 to #level while #level <= #highest_burst_level get $start $end from burst_fields (#level) start end if $start <> '' ! make sure this level is in use do get_burst_field($start, $end, #level, $value) put $value into burst_fields (#level) current_value end-if add 1 to #level end-while ! loop through burst fields and determine if any breaks have occurred move 1 to #level while #level <= #highest_burst_level get $start $saved_value $current_value $action $parameters from burst_fields (#level) start saved_value current_value action parameters if $start <> '' ! make sure this level is in use if $saved_value <> $current_value or #break_triggered_level < #level if #break_triggered_level >= #level move #level to #break_triggered_level end-if do perform_burst_action($action, $parameters, #level) end-if end-if add 1 to #level end-while let #break_triggered_level = #highest_burst_level + 1 ! one last loop to move the current_values to saved_value, after ! we are sure we're done using them. move 1 to #level while #level <= #highest_burst_level let burst_fields.saved_value (#level) = burst_fields.current_value (#level) add 1 to #level end-while ! now we are ready to print the page #ifdef debugv show 'Printing page ' #current_page edit 99,999 ' ( ' #current_line edit 999 ' lines) ' #endif move 1 to #i while #i <= #current_line get $line from page (#i) line print $line (,1) position (+1) add 1 to #i end-while new-page add 1 to #current_page end-if ! #skipped_pages < #skip_past_page end-if ! #current_line > 0 move 1 to #current_line clear-array name=page end-procedure ! page_break ! -------------------------------------------------------------------- begin-procedure get_burst_field($start, $end, #level, :$value) ! tranlate the start expression into a row, column pair unstring $start by ':' into $keyword $params let $params = ltrim(rtrim($params,' '),' ') lowercase $keyword evaluate $keyword when='rowcol' unstring $params by ' ' into $row $column move $row to #row move $column to #column break when-other let $message = 'Invalid keyword "' || $keyword || '" in start expression "' || $start || '" for burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate ! translate the $end expression into a length unstring $end by ':' into $keyword $params lowercase $keyword evaluate $keyword when='len' move $params to #length break when-other let $message = 'Invalid keyword "' || $keyword || '" in end expression "' || $end || '" for burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate ! get the field value get $line from page (#row) line let $value = substr($line, #column, #length) end-procedure ! get_burst_field ! -------------------------------------------------------------------- begin-procedure perform_burst_action($action, $parameters, #level) lowercase $action evaluate $action when = 'none' break when = 'show' do replace_macros($parameters, #level, $text) show $text break when = 'toc' #ifdef debug3 let $message = 'TOC action disabled by -debug3 flag ' || '(but found in burst level ' || to_char(#level) || ').' do error($message, {ERROR_ABORT}) #else position (1) ! work around TOC anchor placement ! bug in ReportMart, which puts the ! anchor below, rather than above, ! the text on the line where the ! entry is to point #ifdef debugb if not #blank_toc_entry_generated ! The first TOC entry we generate is a blank one ! (to work around the SQR bug where the first TOC entry ! is not the same font as all the rest). In some versions of SQR ! (e.g. 4.3.4) it can't be on the same line as the later TOC entry ! due to a bug, so we have to move the regular entry ! down a line as well line 2. (This second bug causes a core dump ! if two TOC-ENTRies are on the same report line.) move {TRUE} to #blank_toc_entry_generated toc-entry level=1 text=' ' position (2) end-if #end-if do replace_macros($parameters, #level, $text) toc-entry level=1 text=$text #endif break when='file' do replace_macros($parameters, #level, $rpt_filespec) new-report $rpt_filespec break when-other let $message = 'Invalid action "' || $action || '" for burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate end-procedure ! perform_burst_action ! -------------------------------------------------------------------- begin-procedure replace_macros($input, #level, :$output) move $input to $orig_input move '' to $output while 1 let #index = instr($input, {MACRO_CHAR}, 0) if #index = 0 ! no more ~s; we're done break end-if let #index2 = instr($input, {MACRO_CHAR}, #index + 1) if #index2 = 0 ! the ~ is unmatched; leave it break end-if let $output = $output || substr($input, 1, #index - 1) let $macro = substr($input, #index + 1, #index2 - #index - 1) let $input = substr($input, #index2 + 1, 999999) let $macro_name = substr($macro, 1, 1) let $macro_params = substr($macro, 2, 99999) evaluate $macro_name when = '' ! a null macro means we just want the macro character concat {MACRO_CHAR} with $output break when = '$' ! environment variable reference let $output = $output || getenv($macro_params) break when = '.' evaluate $macro_params when = 'e' concat '=' with $output break when = 'c' concat ',' with $output break when-other let $message = 'Unrecognized punctuation code "' || $macro_params || '", in macro "' || $macro || '" of "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate when = 'd' if $macro_params = '' move 'YYYYMMDD' to $macro_params end-if #ifndef debug3 let $output = $output || edit($_active_date, $macro_params) #else #ifndef debugd ! this will require a database connection in SQR for Oracle V3 do date_to_formatted($_active_date, $macro_params, $tempdate) let $output = $output || $tempdate #else let $message = 'Date functions disabled by -debug3 and -debugd ' || '(but "' || $macro_name || '" macro found in macro "' || $macro || '" of "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) #end-if #end-if break when = 'i' do parse_filespec($_input_filespec, $input_path, $input_name, $input_ext) evaluate $macro_params when = '' concat $_input_filespec with $output break when = 'p' concat $input_path with $output break when = 'n' concat $input_name with $output break when = 'e' concat $input_ext with $output break when-other let $message = 'Unrecognized file-part-code "' || $macro_params || '", in macro "' || $macro || '" of "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate break when = 'o' do parse_filespec($_initial_report_filespec, $output_path, $output_name, $output_ext) evaluate $macro_params when = '' concat $_initial_report_filespec with $output break when = 'p' concat $output_path with $output break when = 'n' concat $output_name with $output break when = 'e' concat $output_ext with $output break when-other let $message = 'Unrecognized file-part-code "' || $macro_params || '", in macro "' || $macro || '" of "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate break when='0' when='1' when='2' when='3' when='4' when='5' when='6' when='7' when='8' when='9' ! we're inserting the current value of a burst level move $macro to #macro_level if #macro_level = 0 let $message = 'Macro "' || $macro || '" references 0 level in "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) end-if if #macro_level > #_highest_burst_level let $message = 'Macro references unused level "' || $macro || '", in "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) end-if get $value from burst_fields(#macro_level) current_value let $field_flag = ltrim($macro, '0123456789') evaluate $field_flag when = '' let $output = $output || $value break when = 'b' if #macro_level >= #_break_triggered_level let $output = $output || $value end-if break when = 'B' if #macro_level >= #_break_triggered_level let $output = $output || $value else let $output = $output || rpad(' ', length($value), ' ') end-if break when-other let $message = 'Unrecognized field flag "' || $field_flag || '", in macro "' || $macro || '" of "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate when-other let $message = 'Unrecognized macro "' || $macro || '" found in "' || $orig_input || '" on burst level ' || to_char(#level) || '.' do error($message, {ERROR_ABORT}) break end-evaluate end-while concat $input with $output end-procedure ! replace_macros ! -------------------------------------------------------------------- ! The procedure removes any leading printer control codes from the ! input line. If the lines begines with an ESC, we strip off all ! the characters through the last ESC found. We continue stripping ! through to the first capital letter found; this will be the end ! of the final printer control code sequence. begin-procedure remove_printer_codes(:$line) encode '<27>' into $esc if substr($line,1,1) = $esc move 1 to #index ! advance to the last ESC character while #index <> 0 move #index to #strip_to_pos let #index = instr($line, $esc, #index + 1) end-while ! advance to the first capital letter move #strip_to_pos to #index while not range(substr($line,#strip_to_pos,1),'A','Z') add 1 to #strip_to_pos end-while #debugv show 'Stripping printer init codes (' #strip_to_pos edit 9999 #debugv ' characters).' let $line=substr($line,#strip_to_pos + 1, {MAX_RECLEN}) end-if end-procedure ! remove_printer_codes ! -------------------------------------------------------------------- ! This procedure prints an error message and performs various other ! functions, depending on the severity of the error. For example, ! you could add code to the ERROR_ABORT section below to to write the ! input file name to an error log in order to identify the files that ! didn't get successfully converted. begin-procedure error($message, #severity) show show $message evaluate #severity when={ERROR_WARNING} show break when={ERROR_ABORT} show 'Aborting...' show stop quiet break end-evaluate end-procedure ! error ! -------------------------------------------------------------------- ! These procedures replaces part of SQR4's strtodate and "edit" with ! date masks functionality for SQR3. They are only used if -debug3 ! is selected but -debugd is not. #ifdef debug3 #ifndef debugd begin-procedure date_to_formatted($indate, $dateformat, :$outdate) ! if $indate is null, we use SYSDATE; otherwise it is assumed ! to be a date in native format. ! if $dateformat is not null, we use it as the format mask. ! if it is null, we assume the native format for the output. #if {SQR-DATABASE} = 'ORACLE' let $column = cond($indate = '', 'SYSDATE', 'to_char(to_date(''' || $indate || ''')' || cond($dateformat = '', '', ', ''' || $dateformat || '''' ) || ')' ) begin-select [$column] &outdate=char from dual end-select move &outdate to $outdate #endif ! #if {DATABASE} = "ORACLE" end-procedure ! date_to_formatted ! -------------------------------------------------------------------- begin-procedure date_to_native($indate, $dateformat, :$outdate) ! uses $dateformat, if not null, to convert $indate to a date ! in "native" format. If $dateformat is null, we assume ! the informat is also in native format, but run the conversion ! to make sure it is a valid date. #if {SQR-DATABASE} = 'ORACLE' ! if $indate is null, we use SYSDATE let $column = 'to_char(' || cond($indate = '', 'SYSDATE', 'to_date( ''' || $indate || '''') || cond($dateformat = '', '', ', ''' || $dateformat || ''' )') || ')' begin-select [$column] &outdate=char from dual end-select move &outdate to $outdate #endif ! #if {DATABASE} = "ORACLE" end-procedure ! date_to_native #endif ! #ifndef debugd #endif ! #ifdef debug3 ! -------------------------------------------------------------------- ! This procedure takes a code number as input and generates a string ! consisting of the following fields: ! the code in decimal ! the code in hexadecimal ! the ASCII character of the code, if it is displayable, ! or a "^A" sequence if not begin-procedure generate_code_info(#c, :$info) move #c to $info 9999 do num_to_hex(#c,2,$hex) let $info = $info || ' ' || $hex evaluate #c when < 32 ! control codes let $info = $info || ' ^' || chr(#c + ascii('@')) break when < 127 ! regular characters let $info = $info || ' ''' || chr(#c) || '''' break when = 127 ! delete let $info = $info || ' ^?' break when < 160 ! control codes with high bit let $info = $info || ' +^' || chr( #c - 128 + ascii('@')) break when < 255 ! regular characters with high bit let $info = $info || ' ''' || chr(#c) || '''' break when = 255 ! delete with high bit let $info = $info || ' +^?' break end-evaluate end-procedure ! generate_code_info ! -------------------------------------------------------------------- ! This procedure converts the number #n into hexadecimal, padding the ! resulting display to #width columns. (If the hexadecimal value is wider ! than #width, #width will be ignored.) If #n is negative, the result ! will be one character wider than #width (because of the '-'). If ! #width is 0 or negative, no padding will be done. begin-procedure num_to_hex(#n, #width, :$hex) move '' to $hex let #n = trunc(#n,0) if #n < 0 let #n = -#n move '-' to $sign else move '' to $sign end-if while #n > 0 let #remainder = mod(#n,16) let #n = (#n - #remainder) / 16 if #remainder <= 9 let $hex = chr(#remainder + ascii('0')) || $hex else let $hex = chr(#remainder - 10 + ascii('A')) || $hex end-if end-while if #width <= 0 let $hex = $sign || $hex else let $hex = $sign || lpad($hex, #width, '0') end-if end-procedure ! num_to_hex ! -------------------------------------------------------------------- ! This procedure takes template and override filespecs and generates ! a new filespec by applying the defaulting rule: each portion of the ! filespec is separately taken from the override filespec if found there, ! otherwise that part comes from the template. begin-procedure apply_filespec_override($template_filespec, $override_filespec, :$out_filespec) do parse_filespec($template_filespec, $templ_path, $templ_name, $templ_ext) do parse_filespec($override_filespec, $overr_path, $overr_name, $overr_ext) let $out_filespec = cond(isnull($overr_path), $templ_path, $overr_path) || cond(isnull($overr_name), $templ_name, $overr_name) || cond(isnull($overr_ext), $templ_ext, $overr_ext) end-procedure ! apply_filespec_override ! -------------------------------------------------------------------- ! This procedure takes a filespec and separates it into path, filename ! and extension portions. The path, if any, ends with the directory ! separator. The extension, if any, begins with the extension separator. ! (If there is more than one extension separator character found, the ! last one is used as the separator and the others are left at the end ! of the filename.) #if {SQR-PLATFORM} = 'UNIX' #define DIR_SEPARATOR / #define EXT_SEPARATOR . #endif begin-procedure parse_filespec($filespec, :$filepath, :$filename, :$fileext) move '' to $filepath do find_last($filespec, '{DIR_SEPARATOR}', #dir_pos) if #dir_pos > 0 let $filepath = substr($filespec, 1, #dir_pos) let $filespec = substr($filespec,#dir_pos + 1, 99999) end-if do find_last($filespec, '{EXT_SEPARATOR}', #ext_pos) if #ext_pos = 0 move $filespec to $filename move '' to $fileext else let $filename = substr($filespec, 1, #ext_pos - 1) let $fileext = substr($filespec, #ext_pos, 99999) end-if end-procedure ! parse_filespec begin-procedure find_last($string, $substring, :#position) move 0 to #position let #i = instr($string, $substring, 1) while #i > 0 move #i to #position let #i = instr($string, $substring, #i+1) end-while end-procedure ! find_last($string, $substring, #position) ! $Source: /proj/www/WWW/sqr/RCS/lis_to_spf.sqr,v $ ! $Revision: 2.8 $