Curso de COBOL - Aula 4
Notas da aula de 06.12.2008 (Aula #4) do Curso de COBOL da
Escola Alcides Maya com o Professor Roberto Cabral de Mello Borges
Consistência de datas.
* Ler data (exemplo: 311108)
* Consistir (mês de 1 a 12 - dia de 1 a 30 para mês 4, 6, 9, 11 – dia de 1 a 31 para meses 1,3,5,7,8,10,12 – dia de 1 a 29 para mês 2 em ano bissexto – dia de 1 a 28 para mês 2 em ano não-bissexto)
* Imprimir (data PIC 99/99/9999 e mensagem “data válida” ou “data inválida”)
IDENTIFICATION DIVISION.
PROGRAM-ID. CONSISTÊNCIA DE DATAS.
AUTHOR. CABRAL.
DATE-WRITTEN. 06/12/08.
DATE-COMPILED.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IMPRESSAO ASSIGN TO PRINTER.
DATA DIVISION.
FILE SECTION.
FD IMPRESSAO.
01 REG-IMP.
03 DIA-I PIC 99.
03 BARRA-1 PIC X.
03 MES-I PIC 99.
03 BARRA-2 PIC X.
03 ANO-I PIC 9999.
03 ESPACO PIC X(8).
03 MENSAGEM PIC X(8).
01 DATA-HOJE
03 DATA-TODAYS-DATE.
05 MES-T PIC 99.
O5 DIA-T PIC 99.
05 ANO-T PIC 99.
03 DATA-IMPRESSAO.
05 DIA-I PIC 99.
05 FILLER PIC X VALUE “/”.
05 MES-I PIC 99.
05 FILLER PIC X VALUE “/”.
05 ANO-I PIC 99.
WORKING-STORAGE SECTION.
77 DIA PIC 99.
77 MES PIC 99.
77 ANO PIC 9999.
77 QUOC PIC 9999.
77 RESTO-4 PIC 9.
77 RESTO-100 PIC 99.
77 RESTO-400 PIC 999.
77 ANO-HOJE
77 MES-HOJE
77 DIA-HOJE
PROCEDURE DIVISION.
ABRIR.
OPEN OUTPUT IMPRESSAO.
LEITURA.
ACCEPT DIA, MES, ANO.
IF ANO < 1582
STOP RUN.
IF DIA > 31 OR DIA < 1
PERFORM DATA-INVALIDA
* e não GO TO DATA-INVALIDA
ELSE
IF MES > 12 OR MES < 1
PERFORM DATA-INVALIDA
ELSE
IF MES = 4 OR MES = 6 OR MES = 9 OR MES = 11
IF DIA > 30
PERFORM DATA-INVALIDA
ELSE
PERFORM DATA-VALIDA
ELSE
IF MES = 2
* e não IF ANO MOD 4 = 0
DIVIDE ANO BY 4 GIVING QUOC REMAINDER RESTO-4
DIVIDE ANO BY 100 GIVING QUOC REMAINDER RESTO-100
DIVIDE ANO BY 400 GIVING QUOC REMAINDER RESTO-400
IF RESTO-4 = 0
IF RESTO-100 = 0
IF RESTO-400 = 0
IF DIA > 29
PERFORM DATA-INVALIDA
ELSE
PERFORM DATA-VALIDA
ELSE
IF DIA > 28
PERFORM DATA-INVALIDA
ELSE
PERFORM DATA-VALIDA
ELSE
IF DIA > 29
PERFORM DATA-INVALIDA
ELSE
PERFORM DATA-VALIDA
ELSE
IF DIA > 28
PERFORM DATA-INVALIDA
ELSE
PERFORM DATA-VALIDA
ELSE
PERFORM DATA-VALIDA.
GO TO LEITURA.
PARAGRAFO-COMUM.
MOVE “/” TO BARRA-1, BARRA-2.
MOVE DIA TO DIA-I.
MOVE MES TO MES-I.
MOVE ANO TO ANO-I.
MOVE “ – DATA “ TO ESPACO.
DATA-INVALIDA.
PERFORM PARAGRAFO-COMUM.
MOVE “INVÁLIDA” TO MENSAGEM.
WRITE REG-IMP.
DATA-VALIDA.
PERFORM PARAGRAFO-COMUM.
MOVE “INVÁLIDA” TO MENSAGEM.
WRITE REG-IMP.
* Se fosse para testar se a data é de hoje, formar a data de hoje.
MOVE TODAYS-DATE TO DATA-TODAYS-DATE.
MOVE DIA-T TO DIA-I.
MOVE MES-T TO MES-I.
MOVE ANO-T TO ANO-I.
----------------------------------------------
Constantes
SPACES – MOVE SPACES TO MENSAGEM.
ZEROS - MOVE ZEROS TO SALARIO.
LOW-VALUE - conforme o tipo de dados
HIGH-VALUE - conforme o tipo de dados
QUOTES - MOVE QUOTES TO C.
Ainda constantes
77 A PIC 99.
77 B PIC AA.
77 C PIC XX.
MOVE LOW-VALUE TO A, B, C.
A vai ficar com 00 (low-value da PIC 99)
B vai ficar com AA (low-value da PIC AA)
C vai ficar com hexadecimal "00" 0000.0000 (low-value da PIC XX)
MOVE HIGH-VALUE TO A, B, C.
A vai ficar com 99 (high-value da PIC 99)
B vai ficar com ZZ (high-value da PIC AA)
C vai ficar com hexadecimal "FF" 1111.1111 (high-value da PIC XX)
* (ver Tabela ASCII/EBCDIC)
-----------------------------------
TABELAS
* Exemplo para as notas dos alunos
* Usar OCCURS xx TIMES – só não pode ocorrer no nível 1 – Já PIC aparece somente no ultimo nível.
* Exemplo 1
Em Pascal
var Tab: array[1..20] of string[36];
Em COBOL
01 TABELA-1.
03 TAB PIC X(36) OCCURS 20 TIMES.
* Exemplo 2
Em Pascal
var Nota: array[1..20,1..3] of real;
Em COBOL
01 TABELA-2.
03 LINHA OCCURS 20 TIMES.
05 NOTA PIC 99V9 OCCURS 3 TIMES.
* Exemplo 3
Em Pascal
var
Nome: array[1..20] of string;
Data_nasc: array[1..20] of real;
Endereco: array[1..20] of string;
CEP: array[1..20] of real;
Em COBOL
01 TABELA-CADASTRO.
03 TABELA OCCURS 20 TIMES.
05 NOME PIC A(36).
05 DATA-NASC PIC 9(6).
05 ENDERECO PIC X(40).
05 CEP PIC 9(8).
05 FONES PIC X(8) OCCURS 3 TIMES.
* Uso de variável como índice da tabela
IF CEP(17) > 90000000 IF CEP(IND_ALUNO) > 90000000
MOVE FONES (ALUNO, 2) TO FONE-CELULAR.
TABELA VARIÁVEL <> TABELA FIXA
PROCEDURE DIVISION.
INICIO.
.... (carregamento da tabela)
MOVE ZEROS TO INDICE.
Opção 1:
LACO.
ADD 1 TO INDICE.
IF INDICE > 20
STOP RUN.
DISPLAY NOME(INDICE).
GO TO LACO.
Opção 2:
PERFORM IMPRIMIR 20 TIMES.
STOP RUN.
IMPRIMIR.
DISPLAY NOME(INDICE).
Opção 3:
* Não precisa MOVE ZEROS TO INDICE.
PERFORM IMPRIMIR VARYING INDICE FROM 1 BY 1 UNTIL 20.
STOP RUN.
IMPRIMIR.
DISPLAY NOME(INDICE).
Opção 4:
PERFORM IMPRIMIR UNTIL INDICE > 20.
IMPRIMIR.
DISPLAY NOME(INDICE).
-----------------------------------------
Comando SORT
Chave --> ordem (ascendente / descendente)
SORT ARQ-SORT ON ASCENDING KEY NOME-S
USING ARQ-ENTRADA GIVING ARQ-SAIDA.
FILE-CONTROL.
SELECT ARQ-ENTRADA ASSIGN TO DISK.
SELECT ARQ-SORT ASSIGN TO SORT DISK.
SELECT ARQ-SAIDA ASSIGN TO DISK.
DATA DIVISION.
FILE SECTION.
FD ARQ-ENTRADA.
01 REG-ENTRADA.
03 NOME PIC A(36).
03 DATA-NASC PIC 9(8).
03 ENDERECO PIC X(40).
03 CEP PIC 9(8).
03 FONE PIC X(8).
FD ARQ-SAIDA.
01 REG-SAIDA PIC X(100).
SD ARQ-SORT.
01 REG-SORT.
03 NOME-S PIC A(36).
03 FILLER PIC X(54).
PROCEDURE DIVISION.
PARAGRAFO-UNICO.
SORT (e seus parâmetros)
STOP RUN.
Exemplo: SORT ARQ-SORT ON ASCENDING KEY ANO-S, MES-S, DIA-S ON ASCENDING CEP-S.
SORT ARQ-SORT ON DESCENDING MEDIA-S.
INPUT PROCEDURE ENTRADA.
OUTPUT PROCEDURE SAIDA.
ENTRADA SECTION.
ABRIR-ARQUIVO-ENTRADA.
OPEN INPUT ARQ-ENTRADA.
LER.
READ ARQ-ENTRADA
AT END GO TO FIM-ENTRADA.
IF FREQ-E < 50
GO TO LER. * ignora este e vai ler outro.
MOVE REG-ENTRADA TO REG-SORT.
* Os registros têm estruturas iguais.
RELEASE REG-SORT.
GO TO LER.
FIM-ENTRADA.
CLOSE ARQ-ENTRADA.
SAIDA SECTION.
ABRIR-ARQUIVO-SAIDA.
OPEN OUTPUT ARQ-SAIDA.
RETORNAR.
RETURN ARQ-SORT AT END GO TO FIM-SAIDA.
IF MEDIA-S < 6
GO TO RETORNAR. FIM-SAIDA.
* Depois do primeiro com média < 6, só existem outros com média < 6 (porque na saída o arquivo já está ordenado)
MOVE REG-SORT TO REG-SAIDA.
WRITE REG-SAIDA.
OU RELEASE REG-SORT FROM REG-ENTRADA.
FIM-SAIDA.
DATA DIVISION.
FILE SECTION.
FD ARQ-ENTRADA.
01 REG-ENTRADA.
03 NOME-E PIC A(36).
03 DATA-NASC-E PIC 9(8).
03 ENDERECO-E PIC X(40).
03 CEP-E PIC 9(8).
03 FONE-E PIC X(8).
03 MEDIA-E PIC 99V9.
03 FREQ-E PIC 999.
FD ARQ-SAIDA.
01 REG-SAIDA.
03 NOME PIC A(36).
03 DATA-NASC PIC 9(8).
03 ENDERECO PIC X(40).
03 CEP PIC 9(8).
03 FONE PIC X(8).
03 MEDIA PIC 99V9.
03 FREQ PIC 999.
SD ARQ-SORT.
01 REG-SORT.
03 NOME-S PIC A(36).
03 DATA-NASC-S PIC 99.
03 ENDERECO-S PIC X(40).
03 CEP-S PIC 9(8).
03 FONE-S PIC X(8).
03 MEDIA-S PIC 99V9.
03 FREQ-S PIC 999.
PROCEDURE DIVISION.
PARAGRAFO-UNICO.
SORT (e seus parâmetros)
STOP RUN.
Curiosidades:
 O calendário que usamos atualmente, o chamado gregoriano, foi criado em 1582,
 Wordpad II – tem linhas e colunas específicas para digitar 
 Data Juliana – número seqüencial do ano. Hoje é o dia 311 do ano 08.
 Alguns compiladores aceitam que não se repita o nome da variável que está sendo testada (IF dia > 12 or dia < 1)
 COBOL não tem o OPERADOR MOD. Para fazer testes com o resto de divisões, precisamos fazer a divisão, atribuir o resto (remainder) a uma variável, e então fazer os testes com essa variável! (o quociente QUOC não é importante).
 Com as constantes SPACES e ZEROS, não é necessário saber (ou contar) o tamanho do campo, somente o tipo ;-)
 COBOL é a única linguagem que permite tabelas de mais de duas dimensões.
 Estimativas estatísticas: entre os programas que usam tabelas, 90% são de 1 dimensão; 9,9% são de 2 dimensões; e 0,1% tëm 3 ou mais.
 Se o índice passa do valor mais alto, o COBOL trava o programa (ainda bem que não pega lixo!)
 Chave de classificação de datas tem que ser sempre ano-mes-dia, mesmo que a ordem de exibição seja dia-mês-ano.
 No Pascal, o tipo de dados integer não serve para datas dia-mês-ano (maior valor é 32767 – dia 3 mês 28 ano 67) 
 Cursos técnicos e de graduação ensinam as linguagens paradigma ;-) não as “da moda”.
 Já foram criadas 360 linguagens de programação no mundo! :-O
 O SORT do COBOL é feito por divisão otimizada dos dados em grupos pequenos, para agilizar o tempo de resposta.
 Alguns compiladores aceitam até 5 chaves (4 de desempate); a maioria aceita até 3 (duas de desempate).
 Sempre convém filtrar antes de mandar dados para o SORT, porque o tempo de processamento é exponencial.
 * Leitura e gravação são nos REGISTROS!, não nos arquivos. (WRITE REG-algo e não WRITE ARQ-algo)
 * Comando RETURN é “primo-irmão do READ” - Comando RELEASE é “primo-irmão do WRITE” – só p/ SORT.
 * Entrada e Saída têm que ser SECTION. Neste caso não é opcional. – Entrada é um filtro para o SORT!
 * Arquivo do SORT não pode ser aberto nem fechado por nós – o SORT que faz!