600 lines
24 KiB
COBOL
600 lines
24 KiB
COBOL
*
|
|
* Copyright (C) 2003, Hudson Reis,
|
|
* Infocont Sistemas Integrados Ltda.
|
|
*
|
|
* 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,
|
|
* 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.
|
|
*
|
|
* You should have received a copy of the GNU General Public
|
|
* License along with this software; see the file COPYING.
|
|
* If not, write to the Free Software Foundation, Inc., 59 Temple
|
|
* Place, Suite 330, Boston, MA 02111-1307 USA
|
|
*
|
|
identification division.
|
|
program-id. cbl2cob.
|
|
author. Hudson Reis.
|
|
date-written. 03/05/2003.
|
|
*
|
|
* Front-end para pré-processar o fonte de entrada e chamar o
|
|
* parser selecionado, mediante a escolha do usuário.
|
|
*
|
|
environment division.
|
|
configuration section.
|
|
input-output section.
|
|
file-control.
|
|
copy "entrada.sl".
|
|
copy "intermed.sl".
|
|
copy "saida.sl".
|
|
|
|
data division.
|
|
file section.
|
|
copy "entrada.fd".
|
|
copy "intermed.fd".
|
|
copy "saida.fd".
|
|
|
|
working-storage section.
|
|
copy "globals.ws".
|
|
copy "globals.ls".
|
|
77 filler pic x(001) value spaces.
|
|
* Linha de comando para pegar a string digitada pelo usuario.
|
|
77 ws77-linha-comando pic x(512) value spaces.
|
|
* Variáveis que serão usadas para quebrar a frase
|
|
* passada na linha de comando, pelo usuário.
|
|
* O número máximo argumentos supotados é 8.
|
|
01 ws01-args.
|
|
02 ws02-arg-a pic x(256) value spaces.
|
|
02 ws02-arg-b pic x(256) value spaces.
|
|
02 ws02-arg-c pic x(256) value spaces.
|
|
02 ws02-arg-d pic x(256) value spaces.
|
|
02 ws02-arg-e pic x(256) value spaces.
|
|
02 ws02-arg-f pic x(256) value spaces.
|
|
02 ws02-arg-g pic x(256) value spaces.
|
|
02 ws02-arg-h pic x(256) value spaces.
|
|
* Lugar temporário para a switch do dialeto selecionado.
|
|
77 ws77-dialeto-selecionado pic x(256) value spaces.
|
|
* Variáveis para os dialetos.
|
|
77 ws77-dialeto-entrada pic x(003) value spaces.
|
|
88 ws88-microbase value "mb".
|
|
88 ws88-microfocus value "mf".
|
|
88 ws88-rm value "rm".
|
|
* Variável para determinar se o dado a ser tratado é um valor
|
|
* ou uma switch.
|
|
77 ws77-dado pic 9(001) value zeros.
|
|
88 ws88-switch value 0.
|
|
88 ws88-valor value 1.
|
|
* Opções do pre-processador.
|
|
77 ws77-opcoes-pp pic 9(001) value zeros.
|
|
88 ws88-abrir-copybooks value 0.
|
|
88 ws88-fechar-copybooks value 1.
|
|
* Variáveis que vão armazenar o basename de cada arquivo, caso
|
|
* o usuário indique um diretório externo ao diretório corrente
|
|
77 ws77-basename-entrada pic x(256) value spaces.
|
|
77 ws77-basename-saida pic x(256) value spaces.
|
|
* Variáveis com o valor das switches selecionadas.
|
|
77 ws77-escolher-dialeto pic x(002) value "-d".
|
|
77 ws77-mostrar-ajuda pic x(002) value "-h".
|
|
77 ws77-fonte-entrada pic x(002) value "-i".
|
|
77 ws77-fonte-saida pic x(002) value "-o".
|
|
77 ws77-modo-verboso pic x(002) value "-v".
|
|
77 ws77-exibir-versao pic x(002) value "-V".
|
|
* A otimizar.
|
|
77 ws77-linha-para-parsing pic x(256) value spaces.
|
|
01 ws01-case.
|
|
02 ws02-maiusculo pic x(26)
|
|
value "ABCDEFGHIJKLMNOPQRSTUVXYWZ".
|
|
02 ws02-minusculo pic x(26)
|
|
value "abcdefghijklmnopqrstuvxywz".
|
|
|
|
procedure division.
|
|
perform ler-linha-de-comando
|
|
set ws88-abrir-copybooks to true
|
|
perform pre-processar-fonte
|
|
evaluate true
|
|
when ws88-microfocus
|
|
call "mfparser" using ws77-arquivo-entrada
|
|
ws77-arquivo-saida
|
|
ws77-processo
|
|
end-call
|
|
when ws88-microbase
|
|
call "mbparser" using ws77-arquivo-entrada
|
|
ws77-arquivo-saida
|
|
ws77-processo
|
|
end-call
|
|
end-evaluate
|
|
* set ws88-fechar-copybooks to true
|
|
* perform pre-processar-fonte
|
|
perform finalizar
|
|
.
|
|
*****************************************************************
|
|
* Rotinas principais *
|
|
*****************************************************************
|
|
ler-linha-de-comando.
|
|
* 1a. Etapa: Lendo as opções da linha de comando.
|
|
accept ws77-linha-comando from command-line
|
|
if return-code not equal zeros
|
|
display "Tamanho da linha de comando truncada!"
|
|
perform finalizar
|
|
end-if
|
|
if ws88-processo-verboso
|
|
display "Linha de comando: " ws77-linha-comando
|
|
end-if
|
|
unstring ws77-linha-comando delimited by ' ' into
|
|
ws02-arg-a
|
|
ws02-arg-b
|
|
ws02-arg-c
|
|
ws02-arg-d
|
|
ws02-arg-e
|
|
ws02-arg-f
|
|
ws02-arg-g
|
|
ws02-arg-h
|
|
end-unstring
|
|
if ws88-processo-verboso
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-a(ws02-i:1)not equal spaces
|
|
or
|
|
ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento a: " ws02-arg-a(1:ws02-i)
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-b(ws02-i:1) not equal spaces
|
|
or
|
|
ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento b: " ws02-arg-b(1:ws02-i)
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-c(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento c: " ws02-arg-c(1:ws02-i)
|
|
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-d(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento d: " ws02-arg-d(1:ws02-i)
|
|
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-e(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento e: " ws02-arg-e(1:ws02-i)
|
|
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-f(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento f: " ws02-arg-f(1:ws02-i)
|
|
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-g(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento g: " ws02-arg-g(1:ws02-i)
|
|
|
|
perform varying ws02-i from 256 by -1
|
|
until ws02-arg-h(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "Argumento h: " ws02-arg-h(1:ws02-i)
|
|
end-if
|
|
if ws88-switch
|
|
evaluate ws02-arg-a
|
|
when ws77-escolher-dialeto
|
|
move ws02-arg-b to ws77-dialeto-selecionado
|
|
perform escolher-dialeto
|
|
when ws77-mostrar-ajuda
|
|
perform exibir-ajuda
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-b to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-modo-verboso
|
|
set ws88-processo-verboso to true
|
|
when ws77-exibir-versao
|
|
perform exibir-versao
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-valor to true
|
|
end-if
|
|
if ws88-switch
|
|
evaluate ws02-arg-b
|
|
when ws77-escolher-dialeto
|
|
move ws02-arg-c to ws77-dialeto-selecionado
|
|
perform escolher-dialeto
|
|
when ws77-mostrar-ajuda
|
|
perform exibir-ajuda
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-c to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-modo-verboso
|
|
set ws88-processo-verboso to true
|
|
when ws77-exibir-versao
|
|
perform exibir-versao
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-valor to true
|
|
end-if
|
|
if ws88-switch
|
|
evaluate ws02-arg-c
|
|
when ws77-escolher-dialeto
|
|
move ws02-arg-d to ws77-dialeto-selecionado
|
|
perform escolher-dialeto
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-d to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-modo-verboso
|
|
set ws88-processo-verboso to true
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-switch to true
|
|
end-if
|
|
if ws88-continua-parsing
|
|
if ws88-switch
|
|
evaluate ws02-arg-c
|
|
when ws77-modo-verboso
|
|
set ws88-processo-verboso to true
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-d to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-fonte-saida
|
|
move ws02-arg-d to ws77-arquivo-saida
|
|
perform verificar-arquivo-saida
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-switch to true
|
|
end-if
|
|
end-if
|
|
if ws88-continua-parsing
|
|
if ws88-switch
|
|
evaluate ws02-arg-d
|
|
when ws77-modo-verboso
|
|
set ws88-processo-verboso to true
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-e to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-fonte-saida
|
|
move ws02-arg-e to ws77-arquivo-saida
|
|
perform verificar-arquivo-saida
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-switch to true
|
|
end-if
|
|
end-if
|
|
if ws88-continua-parsing
|
|
if ws88-switch
|
|
evaluate ws02-arg-e
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-f to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-fonte-saida
|
|
move ws02-arg-f to ws77-arquivo-saida
|
|
perform verificar-arquivo-saida
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-switch to true
|
|
end-if
|
|
end-if
|
|
if ws88-continua-parsing
|
|
if ws88-switch
|
|
evaluate ws02-arg-f
|
|
when ws77-fonte-entrada
|
|
move ws02-arg-g to ws77-arquivo-entrada
|
|
perform verificar-arquivo-entrada
|
|
when ws77-fonte-saida
|
|
move ws02-arg-g to ws77-arquivo-saida
|
|
perform verificar-arquivo-saida
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-switch to true
|
|
end-if
|
|
end-if
|
|
if ws88-continua-parsing
|
|
if ws88-switch
|
|
evaluate ws02-arg-g
|
|
when ws77-fonte-saida
|
|
move ws02-arg-h to ws77-arquivo-saida
|
|
perform verificar-arquivo-saida
|
|
when other
|
|
perform exibir-ajuda
|
|
end-evaluate
|
|
else
|
|
set ws88-switch to true
|
|
end-if
|
|
end-if
|
|
if ws77-dialeto-entrada equal spaces
|
|
display "Erro na escolha do dialeto"
|
|
perform finalizar
|
|
else
|
|
if ws88-processo-verboso
|
|
evaluate true
|
|
when ws88-microbase
|
|
display "dialeto: Microbase COBOL"
|
|
when ws88-microfocus
|
|
display "dialeto: Microfocus COBOL"
|
|
when ws88-rm
|
|
display "dialeto: RM COBOL"
|
|
when other
|
|
display "Erro na escolha do dialeto"
|
|
perform finalizar
|
|
end-evaluate
|
|
end-if
|
|
end-if
|
|
if ws77-arquivo-entrada equal spaces
|
|
display "Não foi informado arquivo de entrada"
|
|
perform finalizar
|
|
else
|
|
if ws88-processo-verboso
|
|
move zeros to ws02-m
|
|
perform varying ws02-m from 256 by -1 until
|
|
ws77-arquivo-entrada(ws02-m:1) not equal spaces
|
|
continue
|
|
end-perform
|
|
display "input: " ws77-arquivo-entrada(1:ws02-m)
|
|
end-if
|
|
end-if
|
|
if ws77-arquivo-saida equal spaces
|
|
display "Nao foi informado arquivo de saida"
|
|
perform finalizar
|
|
else
|
|
if ws88-processo-verboso
|
|
move zeros to ws02-m
|
|
perform varying ws02-m from 256 by -1 until
|
|
ws77-arquivo-saida(ws02-m:1) not equal spaces
|
|
continue
|
|
end-perform
|
|
display "output: " ws77-arquivo-saida(1:ws02-m)
|
|
end-if
|
|
end-if
|
|
.
|
|
pre-processar-fonte.
|
|
move ws77-arquivo-entrada
|
|
to ws77-arquivo-intermediario
|
|
perform varying ws02-i from 256 by -1
|
|
until ws77-arquivo-intermediario(ws02-i:1)
|
|
not equal spaces
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
compute ws02-j = 256 - ws02-i
|
|
move ".pre" to ws77-arquivo-intermediario(ws02-i:ws02-j)
|
|
if ws88-processo-verboso
|
|
add 4 to ws02-i
|
|
display "Arquivo intermediario: "
|
|
ws77-arquivo-intermediario(1:ws02-i)
|
|
end-if
|
|
open input arquivo-entrada
|
|
if not ws88-ok
|
|
perform testar-file-status
|
|
end-if
|
|
open output arquivo-intermediario
|
|
perform until ws88-fim-arquivo
|
|
read arquivo-entrada
|
|
if not ws88-fim-arquivo
|
|
move reg-arquivo-entrada
|
|
to ws77-linha-para-parsing
|
|
inspect ws77-linha-para-parsing
|
|
converting ws02-minusculo
|
|
to ws02-maiusculo
|
|
move zeros to ws02-i
|
|
inspect ws77-linha-para-parsing
|
|
tallying ws02-i for all " COPY "
|
|
if ws02-i > 0
|
|
perform testes-copy
|
|
else
|
|
write reg-arquivo-intermediario
|
|
from reg-arquivo-entrada
|
|
end-if
|
|
end-if
|
|
end-perform
|
|
close arquivo-entrada arquivo-intermediario
|
|
move ws77-arquivo-intermediario to ws77-arquivo-entrada
|
|
.
|
|
finalizar.
|
|
stop run
|
|
.
|
|
*****************************************************************
|
|
* Procedures secundárias *
|
|
*****************************************************************
|
|
verificar-arquivo-entrada.
|
|
set ws88-continua-parsing to true
|
|
set ws88-valor to true
|
|
open input arquivo-entrada
|
|
if not ws88-ok
|
|
perform testar-file-status
|
|
end-if
|
|
close arquivo-entrada
|
|
.
|
|
verificar-arquivo-saida.
|
|
* Pegar o basename do fonte de entrada.
|
|
perform varying ws02-i from 256 by -1
|
|
until ws77-arquivo-entrada(ws02-i:1)
|
|
not equal spaces
|
|
continue
|
|
end-perform
|
|
* Descobrir o início da string(que pode estar terminado com
|
|
* "/")
|
|
perform varying ws02-j from ws02-i by -1
|
|
until ws77-arquivo-entrada(ws02-j:1)
|
|
equal "/" or ws02-j equal zeros
|
|
continue
|
|
end-perform
|
|
if ws77-arquivo-entrada(ws02-j:1) equal "/"
|
|
add 1 to ws02-j
|
|
compute ws02-k = ws02-i - ws02-j
|
|
add 1 to ws02-k
|
|
move ws77-arquivo-entrada(ws02-j:ws02-k)
|
|
to ws77-basename-entrada
|
|
if ws88-processo-verboso
|
|
display "input a: "
|
|
ws77-arquivo-entrada(ws02-j:ws02-k)
|
|
end-if
|
|
else
|
|
if ws88-processo-verboso
|
|
perform varying ws02-i from 256 by -1
|
|
until ws77-arquivo-entrada(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "input b: " ws77-arquivo-entrada(1:ws02-i)
|
|
end-if
|
|
move ws77-arquivo-entrada to ws77-basename-entrada
|
|
end-if
|
|
|
|
if ws77-arquivo-saida equal spaces
|
|
display "Arquivo de saída não informado"
|
|
perform finalizar
|
|
end-if
|
|
|
|
* Pegar o basename do fonte de saída.
|
|
perform varying ws02-l from 256 by -1
|
|
until ws77-arquivo-saida(ws02-l:1)
|
|
not equal spaces
|
|
continue
|
|
end-perform
|
|
if ws88-processo-verboso
|
|
display "ws02-l: " ws02-l
|
|
end-if
|
|
* Descobrir o início da string(que pode estar terminado com
|
|
* "/")
|
|
perform varying ws02-m from ws02-l by -1
|
|
until ws77-arquivo-saida(ws02-m:1)
|
|
equal "/" or ws02-m equal zeros
|
|
continue
|
|
end-perform
|
|
if ws88-processo-verboso
|
|
display "ws02-m: " ws02-m
|
|
end-if
|
|
if ws77-arquivo-saida(ws02-m:1) equal "/"
|
|
add 1 to ws02-m
|
|
compute ws02-n = ws02-l - ws02-m
|
|
add 1 to ws02-n
|
|
move ws77-arquivo-saida(ws02-m:ws02-n)
|
|
to ws77-basename-saida
|
|
if ws88-processo-verboso
|
|
display "output a: "
|
|
ws77-arquivo-saida(ws02-m:ws02-n)
|
|
end-if
|
|
else
|
|
if ws88-processo-verboso
|
|
perform varying ws02-i from 256 by -1
|
|
until ws77-arquivo-saida(ws02-i:1)
|
|
not equal spaces or ws02-i equal zeros
|
|
continue
|
|
end-perform
|
|
add 1 to ws02-i
|
|
display "output b: " ws77-arquivo-saida(1:ws02-i)
|
|
end-if
|
|
move ws77-arquivo-saida to ws77-basename-saida
|
|
end-if
|
|
|
|
set ws88-finaliza-parsing to true
|
|
set ws88-valor to true
|
|
if ws77-basename-entrada equal ws77-basename-saida
|
|
display "Arquivo de saída igual ao arquivo de entrada"
|
|
perform finalizar
|
|
end-if
|
|
.
|
|
escolher-dialeto.
|
|
set ws88-valor to true
|
|
evaluate ws77-dialeto-selecionado
|
|
when "mb "
|
|
set ws88-microbase to true
|
|
when "mf "
|
|
set ws88-microfocus to true
|
|
when "rm "
|
|
set ws88-rm to true
|
|
when other
|
|
display "Erro na escolha do dialeto"
|
|
perform finalizar
|
|
end-evaluate
|
|
.
|
|
testes-copy.
|
|
move zeros to ws02-i
|
|
inspect ws77-linha-para-parsing
|
|
tallying ws02-i for characters
|
|
before ' "'
|
|
add 3 to ws02-i
|
|
perform varying ws02-j from 256 by -1
|
|
until ws77-linha-para-parsing(ws02-j:1)
|
|
not equal spaces and "."
|
|
continue
|
|
end-perform
|
|
compute ws02-k = ws02-j - ws02-i
|
|
move "*" to reg-arquivo-entrada(7:1)
|
|
write reg-arquivo-intermediario
|
|
from reg-arquivo-entrada
|
|
if ws88-processo-verboso
|
|
display "Copybook: " reg-arquivo-entrada(ws02-i:ws02-k)
|
|
end-if
|
|
move reg-arquivo-entrada(ws02-i:ws02-k)
|
|
to ws77-arquivo-intermediario2
|
|
open input arquivo-intermediario2
|
|
if not ws88-ok
|
|
perform testar-file-status
|
|
end-if
|
|
perform until ws88-fim-arquivo
|
|
read arquivo-intermediario2
|
|
if not ws88-fim-arquivo
|
|
write reg-arquivo-intermediario
|
|
from reg-arquivo-intermediario2
|
|
end-if
|
|
end-perform
|
|
close arquivo-intermediario2
|
|
.
|
|
exibir-versao.
|
|
display "Conversor de fontes CBL2COB - alpha 0.0.2 (lançado e
|
|
- "m 06/10/2003)"
|
|
display "Copyright (C) 2003 Hudson Reis"
|
|
perform finalizar
|
|
.
|
|
exibir-ajuda.
|
|
display "Uso: cbl2cob <opcoes> <arquivo-entrada> [-o <arquiv
|
|
- "o-saida>]"
|
|
display "opções:"
|
|
display " -d <mf/mb/rm> Escolhe dialeto"
|
|
display " -h Mostra ajuda"
|
|
display " -i <arquivo-entrada> Escolhe arquivo de entrada"
|
|
display " -o <arquivo-saida> Escolhe arquivo de saida"
|
|
display " -v Modo verboso"
|
|
display " -V Mostra versão"
|
|
perform finalizar
|
|
.
|
|
copy "globals.pd".
|