CRUD em AdvPL – Parte 15

Introdução

No post anterior, foi feito um Controle de Acesso para a Agenda, certo? Porém, o controle ainda não funciona, pois não foi feita a rotina de manutenção do cadastro de usuários. Logo, vamos criar esta rotina, mas antes disso vamos ver um pouco sobre reaproveitamento de código. Assim, quando partirmos para a rotina de manutenção de usuários não vamos precisar de tantas linhas de código como foi necessário na Agenda.

Reaproveitamento de Código

Quando você programa de modo segmentado, deixando claro o papel de cada função, mesmo que você não use OO (Orientação a Objetos), é relativamente fácil reaproveitar uma função para uma mesma tarefa, feita por entidades do programa diferentes.

Vamos começar pelo acesso aos dados. No programa AGENDA.PRW, existem duas funções, chamadas de OpenDB() e CloseDB(). Ambas, como foram inicialmente projetadas para serem chamadas apenas de dentro do fonte AGENDA.PRW, foram declaradas como STATIC FUNCTION. De fato, o uso de uma STATIC FUNCTION inicialmente limita a chamada desta função para outras funções ou mesmo métodos de classes, desde que eles sejam escritos dentro do mesmo arquivo fonte.

Porém, quando utilizamos o Protheus como plataforma de desenvolvimento, sem uma autorização especial fornecida pela TOTVS, você não consegue declarar uma FUNCTION no código, que poderia ser chamada de outros arquivos fonte. Quando não temos nenhuma autorização diferenciada de compilação, o ambiente Protheus permite a compilação de CLASSES ADVPL,  STATIC FUNCTION(s) e USER FUNCTION(s).

Escopo e Chamada de Funções

Quando declaramos uma USER FUNCTION, por exemplo USER FUNCTION AGENDA(), na verdade a função compilada no repositório de objetos chama-se U_AGENDA — É inserido o prefixo “U_” no nome da função. Uma USER FUNCTION pode ser chamada entre fontes distintos, porém reduz ainda mais a parte útil do nome da função. Exceto quando programamos em TL++ (ainda vamos falar disso em outro post), o AdvPL padrão permite a declaração de funções com até 10 caracteres em seu nome. Logo, quando usamos uma USER FUNCTION, o prefixo “U_” já usa dois caracteres, sobrando apenas 8 caracteres para identificar a função.

Você pode inclusive declarar a função com mais de 10 caracteres, e chamar ela com mais de 10 caracteres, PORÉM somente os 10 primeiros caracteres serão considerados, tanto na declaração quanto na chamada. Por exemplo, declare uma função chamada USER FUNCTION MEUTESTEOK(), e agora, de dentro de outra função, chame U_MEUTESTEX() — a função U_MEUTESTEOK será chamada. A função real compilada no Repositório vai se chamar U_MEUTESTE — com apenas os 10 caracteres significativos — então, se você chamar a função como U_MEUTESTE1 ou U_MEUTESTEX, são considerados apenas os 10 caracteres iniciais do nome da função, inclusive os dois caracteres do prefixo “U_”.

Quando utilizado TL++, onde existe suporte para funções, variáveis, classes, proriedades e métodos com mais de 10 caracteres — acho que vai até 250 — um fonte escrito assim daria erro, pois a chamada da função deve conter o nome inteiro igual a declaração da mesma.

Escopo de Classes AdvPL

Como as classes no AdvPL têm um fator de dinamismo bem alto, e não é necessário possuir um arquivo auxiliar ou #include com a definição da classe para ser possível consumir a classe em AdvPL, basta saber o nome da classe, seus métodos e propriedades para chamar seus construtores, métodos e propriedades, de qualquer arquivo fonte compilado no repositório.

De volta ao reaproveitamento

Se eu quiser usar as funções OpenDB() e CloseDB(), hoje declaradas como STATIC FUNCTION, em mais de um código ou programa fonte do projeto, eu preciso redefinir esta função.

A primeira alternativa poderia ser alterar a declaração de STATIC FUNCTION OPENDB() para USER FUNCTION OPENDB(), e trocar no fonte atual todas as chamadas dela, que originalmente usavam apenas OpenDb(), para o novo nome da função, que passou a se chamar U_OPENDB()

Outra alternativa — mais elegante — seria criar uma classe para agrupar estas funcionalidades — conexão com um Banco de Dados relacional através do DBAccess — e declarar estas funções como métodos da classe, para então criar uma instância da classe no início da execução do código, e fazer a chamada dos seus métodos no lugar das funções.

Embora ambas atendam a nossa necessidade, vamos optar pela mais elegante, vamos criar uma classe, em um novo fonte AdvPL, que deverá ser compilado no Projeto, para então utilizá-lo onde for necessário, em qualquer fonte do projeto.

Funções OpenDB() e CloseDB()

Vamos ver como eram estas funções:

STATIC Function OpenDB()
// Conecta com o DBAccess configurado no ambiente
nH := TCLink()
If nH < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(nH))
  QUIT
Endif
// Liga o filtro para ignorar registros deletados na navegação ISAM 
SET DELETED ON
Return

STATIC Function CloseDB()
DBCloseAll()   // Fecha todas as tabelas
Tcunlink()     // Desconecta do DBAccess
Return

Agora, vamos ver como elas ficariam sendo escritas como métodos de uma classe — que vamos chamar de DBDriver,  criada no novo fonte DBDRIVER.PRW:

CLASS DBDriver
   DATA nHnd as INTEGER 
   METHOD New() CONSTRUCTOR 
   METHOD OpenDB()
   METHOD CloseDB()
ENDCLASS

METHOD New() CLASS DBDriver
::nHnd := -1
return self

METHOD OpenDB() CLASS DBDriver
If ::nHnd > 0 
  // Já estou conectado, torna esta conexão ativa 
  TCSetConn(::nHnd) 
  Return .T. 
Endif
// Conecta com o DBAccess configurado no ambiente
::nHnd := TCLink()
If ::nHnd < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(::nHnd))
  Return .F.
Endif
// Liga o filtro para ignorar registros deletados na navegação ISAM 
SET DELETED ON
Return .T.

METHOD CloseDB() CLASS DBDriver
If ::nHnd > 0 
   DBCloseAll() // Fecha todas as tabelas e alias 
   Tcunlink(::nHnd) // Encerra a conexao atual com o DBAccess
   ::nHnd := -1 
Endif
Return .T.

Reparem no que houve, Eu criei um novo código fonte, chamado DBDRIVER.PRW, e dentro dele transformei as funções OpenDB() e CloseDB() em dos métodos. Depois, nos pontos do código onde as antigas funções eram chamadas, eu passsei a criar uma instância do Driver em uma variável local, chamada oDBSrv, chamando o construtor do Driver — DBDriver():New() — e nas chamadas das funções OpenDB() e CloseDB() , eu passei a chamar elas como métodos da classe, usando oDBSrv:OpenDB() e oDBSrv:CloseDB(). Dessa forma, eu estou isolando estas funcionalidades em um fonte separado, para ser chamado por outros fontes que precisem realizar as mesmas tarefas, como o fonte da Agenda e o fonte do Cadastro de Usuários.

Reaproveitando mais …

Ao implementar o cadastro de usuários na Agenda, a função OpenUsers() foi praticamente uma cópia da OpenAgenda(), trocando o nome da tabela e dos campos. Que tal fazermos dela apenas um método na nova classe DBDRiver?

METHOD OpenTable(cFile,aStru,cIdxUnq,aIndex) CLASS DBDriver
Local cLockId , aDbStru
Local nI , nIndex, cIndex

// Ajusta nome da tabela e cria 
// identificador de Bloqueio de operação
cFile := Upper(cFile)
cLockId := cFile+"_DB"

If empty(aIndex)
   aIndex := {}
Endif
// Quantos indices permanentes tem esta tabela 
nIndex := len(aIndex)

While !GlbNmLock(cLockId)
  If !MsgYesNo("Existe outro processo abrindo a tabela "+cFile+". "+;
               "Deseja tentar novamente ?")
    MsgStop("Abertura da tabela "+cLockId+" em uso -- "+;
           "tente novamente mais tarde.")
    Return .F. 
  Endif
Enddo

If !TCCanOpen(cFile)
  // Se o arquivo nao existe no banco, cria
  DBCreate(cFile,aStru,"TOPCONN")
Endif

// O Arquivo já existe, vamos comparar as estruturas
USE (cFile) ALIAS (cFile) SHARED NEW VIA "TOPCONN"
IF NetErr()
  MsgSTop("Falha ao abrir a tabela "+cFile+" em modo compartilhado. "+;
          "Tente novamente mais tarde.")
  Return .F.
Endif
// Obtêm a estrutura do banco de dados 
aDbStru := DBStruct()
USE

If len(aDbStru) != len(aStru)
  // O tamanho das estruturas mudou ?
  // Vamos alterar a estrutura da tabela
  // Informamos a estrutura atual, e a estrutura esperada
  If !TCAlter(cFile,aDbStru,aStru)
    MsgSTop(tcsqlerror(),"Falha ao alterar a estrutura da tabela "+cFile)
    Return .F. 
  Endif
  MsgInfo("Estrutura do arquivo "+cFile+" atualizada.")
Endif

// Se esta tabela deve ter indice unico
// Cria caso nao exista 
If !empty(cIdxUnq)
  If !TCCanOpen(cFile,cFile+'_UNQ')
    // Se o Indice único da tabela nao existe, cria
    USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
    IF NetErr()
      MsgSTop("Falha ao abrir a tabela "+cFile+" em modo EXCLUSIVO. "+;
              "Tente novamente mais tarde.")
      Return .F.
    Endif
    nRet := TCUnique(cFile,cIdxUnq)
    If nRet < 0
      MsgSTop(tcsqlerror(),;
              "Falha ao criar índice único ["+cIdxUnq+"] "+;
              "para a tabela ["+cFile+"]")
      Return .F.
    Endif
    USE
  EndIf
Endif

// Cria os indices que nao existem para a tabela \
// a Partir do Array de indices informado
For nI := 1 to nIndex
  // Determina o Nome do Indice
  cIndex := cFile+cValToChar(nIndex)
  // Pega a expressão de indexação
  cIdxExpr := aIndex[nI]
  If !TCCanOpen(cFile,cIndex)
    // Se o Indice nao existe, cria 
    USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
    IF NetErr()
      MsgSTop("Falha ao abrir a tabela "+cFile+" em modo EXCLUSIVO. "+;
              "Tente novamente mais tarde.")
      Return .F.
    Endif
    INDEX ON &cIdxExpr TO (cIndex)
    USE
  Endif
EndIf

// Abra o arquivo em modo compartilhado
USE (cFile) ALIAS (cFile) SHARED NEW VIA "TOPCONN"

If NetErr()
  MsgSTop("Falha ao abrir a tabela "+cFile+" em modo compartilhado. "+;
          "Tente novamente mais tarde.")
  Return .F.
Endif

// Abre os indices, seleciona o primeiro
// e posiciona o arquivo no topo

For nI := 1 to nIndex
  cIndex := cFile+cValToChar(nIndex)
  DbSetIndex(cIndex)
Next

DbSetOrder(1)
DbGoTop()

// Solta o MUTEX
GlbNmUnlock(cLockId)

Return .T.

Reparem que tudo o que estava pré-definido em código (ou “CHUMBADO”) agora é recebido por parâmetro. cFile recebe o nome do arquivo, aStru recebe o array com a estrutura da tabela no formato AdvPL, cIdxUnq quando informado deve conter os campos a serem usados para a criação de índice único no SGDB separados por vírgula, e aIndex deve ser um Array de Strings, onde cada elemento corresponde a expressão de indexação para cada índice que deve ser criado para esta tabela.

Vamos ver agora como ficaria a nova função OpenAgenda(), usando o método OpenTable() da classe DBDriver?

STATIC Function OpenAgenda(oDbDrv)
Local cFile := "AGENDA"
Local aStru := {}
Local cIdxUnq 
Local aIndex := {}
Local lOk

// Define a estrutura do arquivo 
aadd(aStru,{"ID"    ,"C",06,0})
aadd(aStru,{"NOME"  ,"C",50,0})
aadd(aStru,{"ENDER" ,"C",50,0})
aadd(aStru,{"COMPL" ,"C",20,0})
aadd(aStru,{"BAIRR" ,"C",30,0})
aadd(aStru,{"CIDADE","C",40,0})
aadd(aStru,{"UF"    ,"C",02,0})
aadd(aStru,{"CEP"   ,"C",08,0})
aadd(aStru,{"FONE1" ,"C",20,0})
aadd(aStru,{"FONE2" ,"C",20,0})
aadd(aStru,{"EMAIL" ,"C",40,0})
aadd(aStru,{"IMAGE" ,"M",10,0})

// Índice único pelo campo ID 
cIdxUnq := "ID"

// Define a estrutura de índices
aadd(aIndex,"ID") // Indice 01 por ID 
aadd(aIndex,"NOME") // Indice 02 por NOME

// Pede para o Driver de Dados abrir a tabela 
lOk := oDbDrv:OpenTable(cFile,aStru,cIdxUnq,aIndex)

Return lOk

Reparem que eu passei tudo como parâmetro para o Driver. Sim, eu também passei a receber como parâmetro o Driver de Dados da aplicação como parâmetro. Mas meu código, com mais de 100 linhas, caiu para 32 linhas ou menos. Ao fazer a mesma coisa com a função OpenUsers(), economizamos mais um montão de linhas e reaproveitamos o código de criação e abertura de tabelas e índices.

STATIC Function OpenUsers(oDbDrv)
Local cFile := "USUARIOS"
Local aStru := {}
Local cIdxUnq 
Local aIndex := {}
Local lOk

// Cria o array com os campos do arquivo 
aadd(aStru,{"IDUSR" ,"C",06,0})
aadd(aStru,{"LOGIN" ,"C",50,0})
aadd(aStru,{"SENHA" ,"C",32,0})

// Índice único pelo campo LOGIN
cIdxUnq := "LOGIN"

// Definição de índices
aadd(aIndex,"IDUSR") // Indice 01 por ID de Usuario 
aadd(aIndex,"LOGIN") // Indice 02 por Login

// Pede para o Driver de Dados abrir a tabela 
lOk := oDbDrv:OpenTable(cFile,aStru,cIdxUnq,aIndex)

Return lOk

Não ficou bem mais simples? O código apenas preencheu as definições necessárias, e a responsabilidade de fazer a mágica é do Driver. De qualquer modo, a simplicidade dos argumentos informados parte de algumas premissas e comportamentos da versão atual deste fonte:

  1. O Método OpenTable() vai criar os índices usando o nome da tabela informado como parâmetro, seguido por um número, iniciando em “1”, para os índices informados, na ordem em que foram informados.
  2. O índice único segue a nomenclatura padrão do DBACCESS — Nome da tabela mais o sufixo “_UNQ”.
  3. A análise realizada na abertura da tabela comparando a diferença entre a estrutura da tabela definida pelo código e a estrutura atual do banco de dados — na versão atual — apenas verifica se o tamanho delas está diferente, não levando em conta a possibilidade de haver alteração de propriedades de campos existentes.
  4. A verificação dos índices limita-se a criar índices inexistentes. Caso seja necessária uma alteração de alguma expressão de indexação, ainda não há verificação para isso na aplicação, devendo o índice ser removido do SGDB para ser recriado pela aplicação.

E, por mais bonito que tenha ficado o fonte desta classe, ele ainda têm uma característica indesejável: Ele ainda faz comunicação direta com a interface, através de funções como MsgInfo(), MsgStop() e afins. Mas não criemos pânico, logo logo vamos refatorar este código também…

Conclusão

Acho que o reaproveitamento do código atual vai precisar de mais uma etapa, antes de partirmos para a inclusão de um novo usuário. Porém, podemos fazer um AJUSTE PONTUAL na rotina, criando um usuário “Inicial”, caso você deseje usar e testar o mecanismo de LOGIN. Para isso, altere a função ChkUser() para ela fazer a inserção do ADMIN com senha em branco caso a tabela esteja fazia, e a partir de então sempre solicitar o login, veja a parte do fonte alterado abaixo:

// Vai para o topo do arquivo 
DbSelectarea("USUARIOS")
DBGoTOP()

If EOF()
   // Se nao tem usuarios , cria um "ADMIN", com senha em branco 
   DBAppend()   
   USUARIOS->IDUSR := '000000'
   USUARIOS->LOGIN := "ADMIN"
   USUARIOS->SENHA := MD5("",HEX_DIGEST)
   DBRUnlock()
Endif

// Faz a validação do usuário 
lOk := DoLogin(oDlg)

No próximo post, vamos continuar refatorando alguns pontos da Agenda para reaproveitar mais código, assim ao invés de COPIAR E COLAR — e replicar código DESNECESSARIAMENTE — usamos a refatoração para reaproveitar uma parte das funcionalidades já escritas, que serão comuns para novos componentes e tabelas da aplicação.

Desejo a todos um bom aproveitamento desse material, e TERABYTES DE SUCESSO 😀

 

Anúncios

Acelerando o AdvPL – Lendo arquivos TXT

Introdução

Alguém me perguntou na sexta-feira, qual era o método mais rápido de ler um arquivo TXT, que utilizava apenas o código ASCII 13 (CR) como quebra de linha… Normalmente eu mesmo usaria as funções FT_Fuse() e FT_FReadLn() para ler o arquivo … mas estas funções não permitem especificar o caractere de quebra… elas trabalham com arquivos TXT onde a quebra pode ser CRLF ou apenas LF.

Como eu não lembrava quem tinha me perguntado, e não achei a pergunta no WhatsApp, e-mail, FaceBook, etc…. resolvi postar a resposta no Facebook mesmo, explicando duas alternativas rápidas de leitura, uma consumindo mais memória e lendo o arquivo inteiro, e outra para arquivos sem limite de tamanho, e consumindo menos memória. Como houve interesse no assunto e diversos comentários, resolvi fazer uma classe de exemplo da segunda abordagem, partindo das premissas do melhor desempenho versus o menor consumo de memória possível.

Fonte da Clase ZFWReadTXT

#include 'protheus.ch'
/* ======================================================================
 Classe ZFWReadTXT
 Autor Júlio Wittwer
 Data 17/10/2015
 Descrição Método de leitura de arquivo TXT
Permite com alto desempenho a leitura de arquivos TXT
 utilizando o identificador de quebra de linha definido
 ====================================================================== */
#define DEFAULT_FILE_BUFFER 4096
CLASS ZFWReadTXT FROM LONGNAMECLASS
  DATA nHnd as Integer
  DATA cFName as String
  DATA cFSep as String
  DATA nFerror as Integer
  DATA nOsError as Integer
  DATA cFerrorStr as String
  DATA nFSize as Integer
  DATA nFReaded as Integer
  DATA nFBuffer as Integer
  DATA _Buffer as Array
  DATA _PosBuffer as Integer
  DATA _Resto as String
  // Metodos Pubicos
  METHOD New()
  METHOD Open()
  METHOD Close()
  METHOD GetFSize()
  METHOD GetError()
  METHOD GetOSError()
  METHOD GetErrorStr()
  METHOD ReadLine()
  // Metodos privados
  METHOD _CleanLastErr()
  METHOD _SetError()
  METHOD _SetOSError()
ENDCLASS
METHOD New( cFName , cFSep , nFBuffer ) CLASS ZFWReadTXT
DEFAULT cFSep := CRLF
DEFAULT nFBuffer := DEFAULT_FILE_BUFFER
::nHnd := -1
::cFName := cFName
::cFSep := cFSep
::_Buffer := {}
::_Resto := ''
::nFSize := 0
::nFReaded := 0
::nFerror := 0
::nOsError := 0
::cFerrorStr := ''
::_PosBuffer := 0
::nFBuffer := nFBuffer
Return self

METHOD Open( iFMode ) CLASS ZFWReadTXT
DEFAULT iFMode := 0
::_CleanLastErr()
If ::nHnd != -1
 _SetError(-1,"Open Error - File already open")
 Return .F.
Endif
// Abre o arquivo
::nHnd := FOpen( ::cFName , iFMode )
If ::nHnd < 0
 _SetOSError(-2,"Open File Error (OS)",ferror())
Return .F.
Endif
// Pega o tamanho do Arquivo
::nFSize := fSeek(::nHnd,0,2)
// Reposiciona no inicio do arquivo
fSeek(::nHnd,0)
Return .T.
METHOD Close() CLASS ZFWReadTXT
::_CleanLastErr()
If ::nHnd == -1
 _SetError(-3,"Close Error - File already closed")
Return .F.
Endif
// Close the file
fClose(::nHnd)
// Clean file read cache 
aSize(::_Buffer,0)
::_Resto := ''
::nHnd := -1
::nFSize := 0
::nFReaded := 0
::_PosBuffer := 0
Return .T.
METHOD ReadLine( /*@*/ cReadLine ) CLASS ZFWReadTXT
Local cTmp := ''
Local cBuffer
Local nRPos
Local nRead
// Incrementa o contador da posição do Buffer
::_PosBuffer++
If ( ::_PosBuffer <= len(::_Buffer) )
 // A proxima linha já está no Buffer ...
 // recupera e retorna
 cReadLine := ::_Buffer[::_PosBuffer]
 Return .T.
Endif
If ( ::nFReaded < ::nFSize )
  // Nao tem linha no Buffer, mas ainda tem partes
  // do arquivo para ler. Lê mais um pedaço
  nRead := fRead(::nHnd , @cTmp, ::nFBuffer)
  if nRead < 0
    _SetOSError(-5,"Read File Error (OS)",ferror())
    Return .F.
  Endif
  // Soma a quantidade de bytes lida no acumulador
  ::nFReaded += nRead
  // Considera no buffer de trabalho o resto
  // da ultima leituraa mais o que acabou de ser lido
  cBuffer := ::_Resto + cTmp
  // Determina a ultima quebra
  nRPos := Rat(::cFSep,cBuffer)
  If nRPos > 0
    // Pega o que sobrou apos a ultima quegra e guarda no resto
    ::_Resto := substr(cBuffer , nRPos + len(::cFSep))
    // Isola o resto do buffer atual
    cBuffer := left(cBuffer , nRPos-1 )
  Else
    // Nao tem resto, o buffer será considerado inteiro
    // ( pode ser final de arquivo sem o ultimo separador )
    ::_Resto := ''
  Endif
 // Limpa e Recria o array de cache
 // Por default linhas vazias são ignoradas
 // Reseta posicionamento de buffer para o primeiro elemento 
 // E Retorna a primeira linha do buffer 
 aSize(::_Buffer,0)
 ::_Buffer := StrTokArr2( cBuffer , ::cFSep )
 ::_PosBuffer := 1
 cReadLine := ::_Buffer[::_PosBuffer]
 Return .T.
Endif
// Chegou no final do arquivo ...
::_SetError(-4,"File is in EOF")
Return .F.
METHOD GetError() CLASS ZFWReadTXT
Return ::nFerror
METHOD GetOSError() CLASS ZFWReadTXT
Return ::nOSError
METHOD GetErrorStr() CLASS ZFWReadTXT
Return ::cFerrorStr
METHOD GetFSize() CLASS ZFWReadTXT
Return ::nFSize
METHOD _SetError(nCode,cStr) CLASS ZFWReadTXT
::nFerror := nCode
::cFerrorStr := cStr
Return
METHOD _SetOSError(nCode,cStr,nOsError) CLASS ZFWReadTXT
::nFerror := nCode
::cFerrorStr := cStr
::nOsError := nOsError
Return
METHOD _CleanLastErr() CLASS ZFWReadTXT
::nFerror := 0
::cFerrorStr := ''
::nOsError := 0
Return

Como funciona

No construtor da classe (método NEW), devemos informar o nome do arquivo a ser aberto, e opcionalmente podemos informar quais são os caracteres que serão considerados como “quebra de linha”. Caso não especificado, o default é CRLF — chr(13)+chr(10). Mas pode ser especificado também apenas Chr(13) (CR) ou Chr(10) (LF). E, como terceiro parâmetro, qual é o tamanho do cache em memória que a leitura pode utilizar. Caso não informado, o valor default são 4 KB (4096 bytes). Caso as linhas de dados do seu TXT tenha em média 1 KB, podemos aumentar seguramente este número para 8 ou 16 KB, para ter um cache em memória por evento de leitura em disco de pelo menos 8 ou 16 linhas.

A idéia é simples: Na classe de encapsulamento de leitura, a linha é lida por referência pelo método ReadLine(), que pode retornar .F. em caso de erros de acesso a disco, ou final de arquivo (todas as linhas já lidas). A abertura do arquivo apenas determina o tamanho do mesmo, para saber quanto precisa ser lido até o final do arquivo. A classe mantém um cache de linhas em um array, e uma propriedade para determinar o ponto atual do cache. Ele começa na primeira linha.

Na primeira leitura, o array de cache está vazio, bem como um buffer temporário chamado “_resto”. A primeira coisa que a leitura faz é incrementar o ponteiro do cache e ver se o ponteiro não passou o final do cache. Como na primeira leitura o cache está vazio, a próxima etapa é verificar se ainda falta ler alguma coisa do arquivo.

Caso ainda exista dados para ler do arquivo, um bloco de 4 KB é lido para a memória, em um buffer de trabalho montado com o resto da leitura anterior (que inicialmente está vazio) mais os dados lidos na operação atual. Então, eu localizo da direita para a esquerda do buffer a ultima quebra do buffer lido, guardo os dados depois da última quebra identificada no buffer “_resto” e removo estes dados do buffer atual de trabalho.

Desse modo, eu vou ter em memória um buffer próximo do tamanho máximo do meu cache (4 KB), considerando a última quebra encontrada neste buffer. Basta eu transformá-lo em um array usando a função StrTokArr2, guardar esse array na propriedade “_Buffer” da classe, e retornar a primeira linha lida.

Quando o método ReadLine() for chamado novamente, o cache vai estar alimentado com “N” linhas do arquivo, eu apenas movo o localizador do cache uma unidade pra frente, e se o localizador ainda está dentro do array, eu retorno a linha correspondente. Eu nem preciso me preocupar em limpar isso a cada leitura, afinal a quantidade de linhas em cache vai ocupar pouco mais de 4 KB mesmo … eu somente vou fazer acesso a disco, e consequente limpeza e realimentação desse cache quando o cache acabar, e ainda houver mais dados no arquivo a ser lido.

Desempenho

Peguei um arquivo TXT aleatório no meu ambiente, que continha um LOG de instalação de um software. O arquivo têm 1477498 bytes, com 12302 linhas de texto. O arquivo foi lido inteiro e todas as linhas identificadas entre 39 e 42 milissegundos (0,039 a 0,042 segundos). Resolvi fazer um outro fonte de testes, lendo este arquivo usando FT_FUSE e FT_FREADLN. Os tempos foram entre 51 e 55 milissegundos (0,051 a 0,055 segundos). E, usando a classe FWFileReader(), os tempos foram entre 101 e 104 milissegundos (0,101 e 0,104 segundos).

Repeti o mesmo teste com um arquivo suficientemente maior, 50 mil linhas e 210 MB .. os tempos foram:

FWFileReader ...... 2,937 s.
FT_FreadLN ........ 1,233 s.
ZFWReadTXT ........ 0,966 s.

Conclusão

Ganhar centésimos de segundo pode parecer pouco … mas centésimos de segundos podem significar uma largada na “pole position”, ou largar na 5a fila … Em uma corrida de 60 voltas, um segundo por volta torna-se um minuto. A máxima do “mais com menos” permanece constante. Quanto menos ciclos de máquina você consumir para realizar um processamento, mais rápido ele será. Quando falamos em aplicações com escalabilidade “estrelar”, para milhões de requisições por segundo, onde temos um limite natural de número de processos dedicados por máquina, quanto mais rápido cada processo for executado, maior “vazão” de processamento pode ser obtido com a mesma máquina. Principalmente quando entramos em ambientes “Cloud”, mesmo tendo grande disponibilidade de processamento, normalmente você será tarifado proporcionalmente ao que consumir. Chegar ao mesmo resultado com menos consumo de recurso fará a diferença 😀

Nos próximos tópicos (aceito sugestões), vou procurar abordar as questões de “como fazer mais rápido” determinada tarefa ou processo, acredito que esta abordagem ajuda a aproximar todos os conceitos de escalabilidade e desempenho que foram abordados apenas na teoria nos posts iniciais sobre este tema !

Agradeço a todos pela audiência do Blog, e não sejam tímidos em dar sugestões, basta enviar a sua sugestão de post siga0984@gmail.com 😀 Para dúvidas pertinentes ao assunto do post, basta postar um comentário no post mesmo 😉

E, pra finalizar, segue abaixo o fonte de teste de desempenho utilizado:

#include 'protheus.ch'
#define TEXT_FILE '\meuarquivo.txt'
/* ======================================================================
Função U_LeFile1, 2 e 3()
Autor Júlio Wittwer
Data 17/10/2015
Descrição Fontes de teste comparativo de desempenho de leitura de arquivo TEXTO
U_LeFile1() - Usa ZFWReadTXT
U_LeFile2() - Usa FT_FREADLN
U_LeFile3() - Usa FWFileReader
====================================================================== */
User Function LeFile1()
Local oTXTFile
Local cLine := ''
Local nLines := 0
Local nTimer
nTimer := seconds()
oTXTFile := ZFWReadTXT():New(TEXT_FILE)
If !oTXTFile:Open()
  MsgStop(oTXTFile:GetErrorStr(),"OPEN ERROR")
  Return
Endif
While oTXTFile:ReadLine(@cLine)
  nLines++
Enddo
oTXTFile:Close()
MsgInfo("Read " + cValToChar(nLines)+" line(s) in "+str(seconds()-nTimer,12,3)+' s.',"Using ZFWReadTXT")
Return
User Function LeFile2()
Local nTimer
Local nLines := 0
nTimer := seconds()
FT_FUSE(TEXT_FILE)
While !FT_FEOF()
  cLine := FT_FReadLN()
  FT_FSkip()
  nLines++
Enddo
FT_FUSE()
MsgInfo("Read " + cValToChar(nLines)+" line(s) in "+str(seconds()-nTimer,12,3)+' s.',"Using FT_FReadLN")
Return
User Function LeFile3()
Local nTimer
Local nLines := 0
Local oFile
nTimer := seconds()
oFile := FWFileReader():New(TEXT_FILE)
If !oFile:Open()
  MsgStop("File Open Error","ERROR")
  Return
Endif
While (!oFile:Eof())
  cLine := oFile:GetLine()
  nLines++
Enddo
oFile:Close()
MsgInfo("Read " + cValToChar(nLines)+" line(s) in "+str(seconds()-nTimer,12,3)+' s.',"Using FWFileReader")
Return

Web Services em AdvPL – Parte 02

Introdução

No tópico anterior sobre Web Services em AdvPL, foi apresentado um overview dos Web Services, e dois exemplos de código AdvPL para atuar como client de Web Services, utilizando um serviço publico na Internet para previsão do tempo.

Hoje, vamos criar um exemplo de um Web Service SERVER em AdvPL, que receberá como parâmetro uma estrutura complexa (ComplexType), e dentro dele um array de estruturas complexas. A idéia inicial era criar um exemplo completo de envio e retorno, mas o tópico ficaria muito grande, então optei por dividí-lo.

Web Service SERVER em AdvPL

Existe um tópico na TDN, que engloba todos os aspectos de criação de um Web Services SERVER em AdvPL, desde a configuração até o deploy de um serviço. Ele está disponível no link http://tdn.totvs.com/pages/viewpage.action?pageId=6064936 . O conteúdo do post atual no blog complementa algumas definições e parte para um exemplo onde é recomendável que você já tenha lido a TDN.

Resumindo em poucas linhas, um Web Service SERVER em AdvPL consiste na declaração de uma classe diferenciada (WSSERVICE), onde configuramos uma interface de publicação para Web Services no TOTVS Application Server, que a partir das classes WSSERVICE compiladas no RPO, consegue disponibilizar uma interface de chamada, consulta e testes via HTTP, bem como a definição (WSDL) da classe para que outras linguagens que trabalham nativamente com Web Services sejam capazes de gerar uma classe Client para consumir este Web Service.

Parâmetros e retornos

Na declaração de um Web Services SERVER em AdvPL, os parâmetros e retornos dos métodos devem ser declarados como propriedades da classe. O tipo destes parâmetros podem ser tipos simples ( http://tdn.totvs.com/pages/viewpage.action?pageId=6064941 ) ou tipos complexos ( http://tdn.totvs.com/display/tec/05.+Estruturas+-+Tipos+complexos ). Quando a quantidade de elementos de um parametro (simples ou compexo) for maior que 1, podemos declarar a propriedade como um ARRAY OF , onde o tipo pode ser simples ou complexo.

Na prática, um tipo complexo não passa de um agrupamento de um ou mais tipos simples ou complexos, como se fosse uma estrutura (classe sem métodos). Em um Web Service AdvPL, é possível declarar metodos para as estruturas, mas os métodos das estruturas não são publicados no WSDL, podem ser usados apenas dentro da classe de Web Service SERVER.

Projeto Web Services TORNEIOS

Vamos partir de um exemplo didático da criação de um WebServices para cadastrar um torneio esportivo. Os dados relevantes do torneio são as datas de inicio e final, uma descrição, e uma lista de atletas participantes. Cada atleta deve informar seu CPF, nome e data de nascimento. Opcionalmente, o atleta pode informar seu peso (em Kg) e altura (em metros).

Logo, precisamos de uma estrutura para os dados de um torneio e outra para os dados do atleta. Como um torneio pode ter vários atletas, a estrutura do atleta deve ser declarada como uma propriedade do tipo ARRAY OF ATLETA na estrutura de torneios. Vamos à primeira parte do código:

( Fonte WSSRV01.PRW )

#include "protheus.ch"
#include "apwebsrv.ch"
/* -------------------------------------------------------------
Fonte WSSRV01.PRW 
Autor Julio Wittwer
Data 10/06/2015
Descrição Fonte de exemplo de Web Services Server com 
 recebimento e retorno de tipos complexos 
 e array de tipos complexos
------------------------------------------------------------- */
// Estutura de dados de um atleta
// CPF, Nome, Aniversário ( obrigatorios ) 
// peso e altura ( opcionais )
WSSTRUCT ATLETA
 
 WSDATA CPF as STRING
 WSDATA Nome as STRING
 WSDATA Nascim as DATE 
 WSDATA PesoKg as FLOAT OPTIONAL
 WSDATA Altura as FLOAT OPTIONAL
ENDWSSTRUCT
// Estrutura de dados de um torneio 
// Descrição, data de inicio e término, e array de atletas participantes
WSSTRUCt TORNEIO
WSDATA Descricao as STRING
 WSDATA Inicio as DATE
 WSDATA Final as DATE 
 WSDATA Atletas as ARRAY OF ATLETA
 
ENDWSSTRUCT

Todas as propriedades declaradas nas estruturas (WSDATA) por default são obrigatórias. Para tornar uma propriedade opcional, usamos a palavra reservada “OPTIONAL” após o tipo da propriedade. Feita a declaração das estruturas, vamos agora para a prototipação da classe.

// Prototipação do WebServices
// Serviço de cadastro de torneios esportivos
WSSERVICE TORNEIOS DESCRIPTION "Torneios Esportivos"
 
 // propriedades de entrada e retorno, usados 
 // como parametros ou retornos nos metodos
 
 WSDATA TorneioIn AS TORNEIO 
 WSDATA Status as INTEGER 
 
 // Metodos do WebService
 WSMETHOD Incluir
ENDWSSERVICE

Por enquanto o WebService vai apenas receber os dados completos de um torneio. O foco do exemplo é justamente como os dados serão recebidos, e como você poderá enviá-los através de um Web Service client em AdvPL criado pela geração de classe client do TDS ou pela nova classe tWSDLManager. O exemplo não abrange a persistência das informações em base de dados. Agora, vamos implementar o método “Incluir” neste fonte:

// Metodo de inclusao. Recebe um Torneio com todos os dados 
// e o array de atletas, e retorna um status numerico ( 0 = sucesso )
WSMETHOD Incluir WSRECEIVE TorneioIn WSSEND Status WSSERVICE TORNEIOS 
 
// Vamos ver tudo o que chegou como parametro
// varinfo("TorneioIn",::TorneioIn) 
 
/*
TorneioIn -> OBJECT ( 4) [...]
 TorneioIn:ATLETAS -> ARRAY ( 2) [...]
 TorneioIn:ATLETAS[1] -> OBJECT ( 5) [...]
 TorneioIn:ATLETAS[1]:ALTURA -> U ( 1) [ ]
 TorneioIn:ATLETAS[1]:CPF -> C ( 12) [123456789-09]
 TorneioIn:ATLETAS[1]:NASCIM -> D ( 8) [02/02/81]
 TorneioIn:ATLETAS[1]:NOME -> C ( 13) [Joao da Silva]
 TorneioIn:ATLETAS[1]:PESOKG -> N ( 15) [ 72.5000]
 TorneioIn:ATLETAS[2] -> OBJECT ( 5) [...]
 TorneioIn:ATLETAS[2]:ALTURA -> U ( 1) [ ]
 TorneioIn:ATLETAS[2]:CPF -> C ( 12) [111111111-11]
 TorneioIn:ATLETAS[2]:NASCIM -> D ( 8) [03/03/80]
 TorneioIn:ATLETAS[2]:NOME -> C ( 13) [Jose da Silva]
 TorneioIn:ATLETAS[2]:PESOKG -> N ( 15) [ 75.2000]
 TorneioIn:DESCRICAO -> C ( 16) [Torneio de Teste]
 TorneioIn:FINAL -> D ( 8) [06/29/15]
 TorneioIn:INICIO -> D ( 8) [06/28/15]
*/
 
// com isso conseguimos montar facilmente o codigo AdvPl para tratar os dados 
// recebidos nesta propriedade. Logo abaixo, eu mostro na tela de console do 
// TOTVS App server a descricao do torneio recebida, e o nome dos atletas recebidos
conout("Torneio : "+TorneioIn:DESCRICAO)
conout("Atletas : "+cValToChar( len(TorneioIn:ATLETAS) ))
For nI := 1 to len(TorneioIn:ATLETAS)
 conout(TorneioIn:ATLETAS[nI]:Nome)
Next
// Caso o processamento seja concluido com sucesso, 
// alimentamos a propriedade de retorno com 0
// em caso de falha, podemos usar um ou mais numeros negativos para indicar
// uma impossibilidade de processamento, como um torneio na mesma data....
::Status := 0
Return .T.

Uma vez criado o fonte e compilado no RPO, e configurado adequadamente o APPServer para ser um servidor de HTTP para WEB Services (vide documentação da TDN), podemos partir para a geração do fonte client em AdvPL.

Exemplo gerando o fonte client de Web Services

Primeiro, vamos gerar um fonte client AdvPL usando o IDE ou TDS. Usando o endereço HTTP onde foi disponibilizado o WSDL deste serviço, o código fonte client gerado deve ficar assim:

( Fonte WSCLI01.PRW )

#INCLUDE "PROTHEUS.CH"
#INCLUDE "APWEBSRV.CH"
/* ===============================================================================
WSDL Location http://localhost/ws/TORNEIOS.apw?WSDL
Gerado em 06/28/15 15:31:26
Observações Código-Fonte gerado por ADVPL WSDL Client 1.120703
 Alterações neste arquivo podem causar funcionamento incorreto
 e serão perdidas caso o código-fonte seja gerado novamente.
=============================================================================== */
User Function _SSLXTLW ; Return // "dummy" function - Internal Use
/* -------------------------------------------------------------------------------
WSDL Service WSTORNEIOS
------------------------------------------------------------------------------- */
WSCLIENT WSTORNEIOS
WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD RESET
 WSMETHOD CLONE
 WSMETHOD INCLUIR
WSDATA _URL AS String
 WSDATA _HEADOUT AS Array of String
 WSDATA _COOKIES AS Array of String
 WSDATA oWSTORNEIOIN AS TORNEIOS_TORNEIO
 WSDATA nINCLUIRRESULT AS integer
// Estruturas mantidas por compatibilidade - NÃO USAR
 WSDATA oWSTORNEIO AS TORNEIOS_TORNEIO
ENDWSCLIENT
WSMETHOD NEW WSCLIENT WSTORNEIOS
::Init()
If !FindFunction("XMLCHILDEX")
 UserException("O Código-Fonte Client atual requer os executáveis do Protheus Build [7.00.131227A-20150620] ou superior. Atualize o Protheus ou gere o Código-Fonte novamente utilizando o Build atual.")
EndIf
Return Self
WSMETHOD INIT WSCLIENT WSTORNEIOS
 ::oWSTORNEIOIN := TORNEIOS_TORNEIO():New()
// Estruturas mantidas por compatibilidade - NÃO USAR
 ::oWSTORNEIO := ::oWSTORNEIOIN
Return
WSMETHOD RESET WSCLIENT WSTORNEIOS
 ::oWSTORNEIOIN := NIL 
 ::nINCLUIRRESULT := NIL
// Estruturas mantidas por compatibilidade - NÃO USAR
 ::oWSTORNEIO := NIL
 ::Init()
Return
WSMETHOD CLONE WSCLIENT WSTORNEIOS
Local oClone := WSTORNEIOS():New()
 oClone:_URL := ::_URL 
 oClone:oWSTORNEIOIN := IIF(::oWSTORNEIOIN = NIL , NIL ,::oWSTORNEIOIN:Clone() )
 oClone:nINCLUIRRESULT := ::nINCLUIRRESULT
// Estruturas mantidas por compatibilidade - NÃO USAR
 oClone:oWSTORNEIO := oClone:oWSTORNEIOIN
Return oClone
// WSDL Method INCLUIR of Service WSTORNEIOS
WSMETHOD INCLUIR WSSEND oWSTORNEIOIN WSRECEIVE nINCLUIRRESULT WSCLIENT WSTORNEIOS
Local cSoap := "" , oXmlRet
BEGIN WSMETHOD
cSoap += 'xmlns="http://localhost/">'
cSoap += WSSoapValue("TORNEIOIN", ::oWSTORNEIOIN, oWSTORNEIOIN , "TORNEIO", .T. , .F., 0 , NIL, .F.) 
cSoap += "</INCLUIR>"
oXmlRet := SvcSoapCall( Self,cSoap,; 
 "http://localhost/INCLUIR",; 
 "DOCUMENT","http://localhost/",,"1.031217",; 
 "http://localhost/ws/TORNEIOS.apw")
::Init()
::nINCLUIRRESULT := WSAdvValue( oXmlRet,"_INCLUIRRESPONSE:_INCLUIRRESULT:TEXT","integer",NIL,NIL,NIL,NIL,NIL,NIL)
END WSMETHOD
oXmlRet := NIL
Return .T.
// WSDL Data Structure TORNEIO
WSSTRUCT TORNEIOS_TORNEIO
 WSDATA oWSATLETAS AS TORNEIOS_ARRAYOFATLETA
 WSDATA cDESCRICAO AS string
 WSDATA dFINAL AS date
 WSDATA dINICIO AS date
 WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT
WSMETHOD NEW WSCLIENT TORNEIOS_TORNEIO
 ::Init()
Return Self
WSMETHOD INIT WSCLIENT TORNEIOS_TORNEIO
Return
WSMETHOD CLONE WSCLIENT TORNEIOS_TORNEIO
 Local oClone := TORNEIOS_TORNEIO():NEW()
 oClone:oWSATLETAS := IIF(::oWSATLETAS = NIL , NIL , ::oWSATLETAS:Clone() )
 oClone:cDESCRICAO := ::cDESCRICAO
 oClone:dFINAL := ::dFINAL
 oClone:dINICIO := ::dINICIO
Return oClone
WSMETHOD SOAPSEND WSCLIENT TORNEIOS_TORNEIO
 Local cSoap := ""
 cSoap += WSSoapValue("ATLETAS", ::oWSATLETAS, ::oWSATLETAS , "ARRAYOFATLETA", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("DESCRICAO", ::cDESCRICAO, ::cDESCRICAO , "string", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("FINAL", ::dFINAL, ::dFINAL , "date", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("INICIO", ::dINICIO, ::dINICIO , "date", .T. , .F., 0 , NIL, .F.) 
Return cSoap
WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT TORNEIOS_TORNEIO
 Local oNode1
 ::Init()
 If oResponse = NIL ; Return ; Endif 
 oNode1 := WSAdvValue( oResponse,"_ATLETAS","ARRAYOFATLETA",NIL,"Property oWSATLETAS as s0:ARRAYOFATLETA on SOAP Response not found.",NIL,"O",NIL,NIL) 
 If oNode1 != NIL
 ::oWSATLETAS := TORNEIOS_ARRAYOFATLETA():New()
 ::oWSATLETAS:SoapRecv(oNode1)
 EndIf
 ::cDESCRICAO := WSAdvValue( oResponse,"_DESCRICAO","string",NIL,"Property cDESCRICAO as s:string on SOAP Response not found.",NIL,"S",NIL,NIL) 
 ::dFINAL := WSAdvValue( oResponse,"_FINAL","date",NIL,"Property dFINAL as s:date on SOAP Response not found.",NIL,"D",NIL,NIL) 
 ::dINICIO := WSAdvValue( oResponse,"_INICIO","date",NIL,"Property dINICIO as s:date on SOAP Response not found.",NIL,"D",NIL,NIL) 
Return
// WSDL Data Structure ARRAYOFATLETA
WSSTRUCT TORNEIOS_ARRAYOFATLETA
 WSDATA oWSATLETA AS TORNEIOS_ATLETA OPTIONAL
 WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT
WSMETHOD NEW WSCLIENT TORNEIOS_ARRAYOFATLETA
 ::Init()
Return Self
WSMETHOD INIT WSCLIENT TORNEIOS_ARRAYOFATLETA
 ::oWSATLETA := {} // Array Of TORNEIOS_ATLETA():New()
Return
WSMETHOD CLONE WSCLIENT TORNEIOS_ARRAYOFATLETA
 Local oClone := TORNEIOS_ARRAYOFATLETA():NEW()
 oClone:oWSATLETA := NIL
 If ::oWSATLETA <> NIL 
 oClone:oWSATLETA := {}
 aEval( ::oWSATLETA , { |x| aadd( oClone:oWSATLETA , x:Clone() ) } )
 Endif 
Return oClone
WSMETHOD SOAPSEND WSCLIENT TORNEIOS_ARRAYOFATLETA
 Local cSoap := ""
 aEval( ::oWSATLETA , {|x| cSoap := cSoap + WSSoapValue("ATLETA", x , x , "ATLETA", .F. , .F., 0 , NIL, .F.) } ) 
Return cSoap
WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT TORNEIOS_ARRAYOFATLETA
 Local nRElem1, oNodes1, nTElem1
 ::Init()
 If oResponse = NIL ; Return ; Endif 
 oNodes1 := WSAdvValue( oResponse,"_ATLETA","ATLETA",{},NIL,.T.,"O",NIL,NIL) 
 nTElem1 := len(oNodes1)
 For nRElem1 := 1 to nTElem1 
 If !WSIsNilNode( oNodes1[nRElem1] )
 aadd(::oWSATLETA , TORNEIOS_ATLETA():New() )
 ::oWSATLETA[len(::oWSATLETA)]:SoapRecv(oNodes1[nRElem1])
 Endif
 Next
Return
// WSDL Data Structure ATLETA
WSSTRUCT TORNEIOS_ATLETA
 WSDATA nALTURA AS float OPTIONAL
 WSDATA cCPF AS string
 WSDATA dNASCIM AS date
 WSDATA cNOME AS string
 WSDATA nPESOKG AS float OPTIONAL
 WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT
WSMETHOD NEW WSCLIENT TORNEIOS_ATLETA
 ::Init()
Return Self
WSMETHOD INIT WSCLIENT TORNEIOS_ATLETA
Return
WSMETHOD CLONE WSCLIENT TORNEIOS_ATLETA
 Local oClone := TORNEIOS_ATLETA():NEW()
 oClone:nALTURA := ::nALTURA
 oClone:cCPF := ::cCPF
 oClone:dNASCIM := ::dNASCIM
 oClone:cNOME := ::cNOME
 oClone:nPESOKG := ::nPESOKG
Return oClone
WSMETHOD SOAPSEND WSCLIENT TORNEIOS_ATLETA
 Local cSoap := ""
 cSoap += WSSoapValue("ALTURA", ::nALTURA, ::nALTURA , "float", .F. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("CPF", ::cCPF, ::cCPF , "string", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("NASCIM", ::dNASCIM, ::dNASCIM , "date", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("NOME", ::cNOME, ::cNOME , "string", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("PESOKG", ::nPESOKG, ::nPESOKG , "float", .F. , .F., 0 , NIL, .F.) 
Return cSoap
WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT TORNEIOS_ATLETA
 ::Init()
 If oResponse = NIL ; Return ; Endif 
 ::nALTURA := WSAdvValue( oResponse,"_ALTURA","float",NIL,NIL,NIL,"N",NIL,NIL) 
 ::cCPF := WSAdvValue( oResponse,"_CPF","string",NIL,"Property cCPF as s:string on SOAP Response not found.",NIL,"S",NIL,NIL) 
 ::dNASCIM := WSAdvValue( oResponse,"_NASCIM","date",NIL,"Property dNASCIM as s:date on SOAP Response not found.",NIL,"D",NIL,NIL) 
 ::cNOME := WSAdvValue( oResponse,"_NOME","string",NIL,"Property cNOME as s:string on SOAP Response not found.",NIL,"S",NIL,NIL) 
 ::nPESOKG := WSAdvValue( oResponse,"_PESOKG","float",NIL,NIL,NIL,"N",NIL,NIL) 
Return

Agora, podemos montar um novo fonte ( WSTST01.PRW ), que vai usar a classe client gerada no AdvPL para interagir com este serviço. No fonte abaixo, todos os detalhes da implementação e o passo a passo utilizado para entender como usar as estruturas e métodos definidos na classe client do Web Service.

#include "protheus.ch"
/* ===========================================================================
Fonte WSTST01.PRW
Funcoes U_TST01I()
Autor Julio Wittwer
Data 10/06/2015
Descricao Fonte de testes da classe client do WebService "TORNEIOS" em AddPl
=========================================================================== */
User Function Tst01I()
Local oWSClient 
Local oAtleta
SET DATE BRITISH
SET CENTURY ON 
SET EPOCH TO 1960
 
// Cria a instância da classe Client do WebService de Torneios
oWSClient := WSTORNEIOS():New()
/*
Vamos chamar a inclusao de torneios. para isso, primeiro vemos qual foi o metodo 
de inclusao gerado na classe client Advpl
WSMETHOD INCLUIR WSSEND oWSTORNEIOIN WSRECEIVE nINCLUIRRESULT WSCLIENT WSTORNEIOS
*/
// o parametro oWSTorneioIn é uma estrutura nomeada de TORNEIOS_TORNEIO
// Como esta estrutura é um parâmetro de um método, ela já vem 
// criada, mas seus valores nao estao preenchidos 
// vamos preencher as propriedades desta estrutura
// consultamos as propriedades da estrutura no fonte Client Advpl gerado
/*
WSSTRUCT TORNEIOS_TORNEIO
 WSDATA oWSATLETAS AS TORNEIOS_ARRAYOFATLETA
 WSDATA cDESCRICAO AS string
 WSDATA dFINAL AS date
 WSDATA dINICIO AS date
(...)
*/
oWSClient:oWSTORNEIOIN:cDESCRICAO := 'Torneio de Teste'
oWSClient:oWSTORNEIOIN:dInicio := date()+1
oWSClient:oWSTORNEIOIN:dFinal := date()+2
// Dentro da estrutura de torneio, temos tambem a propriedade oWSAtletas
// Como ela nao vem criada, vamos criar uma instância dela
oWSClient:oWSTORNEIOIN:oWSATLETAS := TORNEIOS_ARRAYOFATLETA():New()
// Como a estrutura é um encapsulamento de array de objetos, 
// a propriedade oWSATLETA desta estrutura vem com {} um array vazio 
// ::oWSATLETA := {} // Array Of TORNEIOS_ATLETA():New()
// Para cada atleta a acrescentar, criamos uma nova instancia da estrutura 
// TORNEIOS_ATLETA . Devemos ver a declaração da estrutura para saber 
// quais propriedades devem ser preenchidas
 
/*
WSSTRUCT TORNEIOS_ATLETA
 WSDATA nALTURA AS float OPTIONAL
 WSDATA cCPF AS string
 WSDATA dNASCIM AS date
 WSDATA cNOME AS string
 WSDATA nPESOKG AS float OPTIONAL
(...)
*/
oAtleta := TORNEIOS_ATLETA():New()
oAtleta:cNome := "Joao da Silva"
oAtleta:cCPF := "123456789-09"
oAtleta:dNASCIM := ctod('02/02/1981')
oAtleta:nPESOKG := 72.5
// agora acrescentamos o atleta da propriedade correta
aadd( oWSClient:oWSTORNEIOIN:oWSATLETAS:oWSATLETA , oAtleta ) 
 
// Criamos um novo atleta
oAtleta := TORNEIOS_ATLETA():New()
oAtleta:cNome := "Jose da Silva"
oAtleta:cCPF := "111111111-11"
oAtleta:dNASCIM := ctod('03/03/1980')
oAtleta:nPESOKG := 75.2
// agora acrescentamos o segundo atleta da propriedade correta
aadd( oWSClient:oWSTORNEIOIN:oWSATLETAS:oWSATLETA , oAtleta )
// vamos ver como ficou a estrutura 
// varinfo("oWSClient:oWSTORNEIOIN",oWSClient:oWSTORNEIOIN)
// agora vamos chamar o metodo de inclusao
If oWSClient:Incluir() 
 
 // Chamada realizada com sucesso. 
 // Vamos ver o que chegou na propriedade de retorno
 msgInfo("Codigo de retorno = "+cValToChar(oWSClient:nINCLUIRRESULT),"Chamada realizada.")
Else
// houve algum erro na chamada
 // ou no processamento do webservice 
 MsgStop(getwscerror(3))
Endif
Return

A função de testes de inclusão ( U_TST01I ) pode ser chamada diretamente pelo SmartClient, não precisa colocar ela dentro do Menu do ERP. Os dados utilizados para os atletas estão “chumbados” no fonte. Ao ser executado, o Web Services SERVER deve receber e aceitar o XML enviado por HTTP, e mostrar no LOG de console a descrição do torneio e o nome dos dois atletas informados.

Exemplo usando tWSDLManager

Agora sim, vamos ver como é possível usar a casse nova de Web Services para informar estruturas complexas, e arrays de estruturas complexas.

A classe tWSDLManager permite mapear, a partir do WSDL, as estruturas complexas e tipos simples que precisam ser enviados para uma requisição de WebServices. Como um tipo complexo na verdade é um agrupamento de tipos simples, ao usar o método SimpleInput(), vamos obter um array contendo os identificadores de todos os dados que podem ser enviados, porem a classe considera por default que voce vai enviar apenas uma ocorrencia de um dado ou estrutura. Como nós sabemos que vamos inserir mais de um valor, precisamos dizer para a classe quantos valores serão informados, e somente com estes valores definidos podemos usar o método SimpleInput() para ver como e onde os dados serão informados. Toda a sequencia de identificação está documentada no proprio fonte, em linhas de comentário.

#include "protheus.ch"
/* ===========================================================================
Fonte WSTST02.PRW
Funcoes U_TST02I()
Autor Julio Wittwer
Data 28/06/2015
Descricao Fonte de testes do webService de Torneios, usando a nova classe
 client de websservices "tWSDLManager"
http://tdn.totvs.com/display/tec/Classe+TWsdlManager
=========================================================================== */
User Function TST02I()
Local oWSDL
Local lOk, cResp, aElem, nPos
oWSDL := tWSDLManager():New()
// Seta o modo de trabalho da classe para "verbose"
// apenas para fins de desenvolvimento e depuracao
// oWSDL:lVerbose := .T.
// Primeiro faz o parser do WSDL a partir da URL
lOk := oWsdl:ParseURL( "http://localhost/ws/TORNEIOS.apw?WSDL" )
if !lOk
 MsgStop( oWsdl:cError , "ParseURL() ERROR")
 Return
endif
// Lista as operações disponíveis
// aOps := oWsdl:ListOperations()
// varinfo( "aOps", aOps )
/*
aOps -> ARRAY ( 1) [...]
aOps[1] -> ARRAY ( 2) [...]
aOps[1][1] -> C ( 7) [INCLUIR]
aOps[1][2] -> C ( 0) []
*/
// Seta a operação a ser utilizada
lOk := oWsdl:SetOperation( "INCLUIR" )
if !lOk
 MsgStop( oWsdl:cError , "SetOperation(INCLUIR) ERROR")
 Return
endif
// Agora vamos ver os parametros de chamada da inclusao
// primeiro, devemos verificar os complex types de
// tamanho variavel.
// aParC := oWsdl:ComplexInput()
// varinfo("aParC",aParC)
/*
aParC -> ARRAY ( 1) [...]
aParC[1] -> ARRAY ( 5) [...]
aParC[1][1] -> N ( 15) [ 3.0000] // ID da estrutura complexa variavel
aParC[1][2] -> C ( 6) [ATLETA]
aParC[1][3] -> N ( 15) [ 0.0000] // numero minimo de ocorrencias
aParC[1][4] -> N ( 15) [2147483647.0000] // numero maximo de ocorrencias
aParC[1][5] -> C ( 31) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1] // lista de elementos "pai" desta estrutura
*/
// Como sabemos que vamos enviar 2 atletas,
// definimos esta quantidade usando o metodo SetComplexOccurs
oWSDL:SetComplexOccurs(3,2) // Id do complex type, quantidade a ser enviada
// Apenas depois de definirmos quantos tipos complexos queremos enviar,
// podemos listar os tipos simples.
// aParS := oWsdl:SimpleInput()
// varinfo("aParS",aParS)
/*
aParS -> ARRAY ( 13) [...]
aParS[1] -> ARRAY ( 5) [...]
aParS[1][1] -> N ( 15) [ 0.0000]
aParS[1][2] -> C ( 6) [ALTURA]
aParS[1][3] -> N ( 15) [ 0.0000]
aParS[1][4] -> N ( 15) [ 1.0000]
aParS[1][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[2] -> ARRAY ( 5) [...]
aParS[2][1] -> N ( 15) [ 1.0000]
aParS[2][2] -> C ( 3) [CPF]
aParS[2][3] -> N ( 15) [ 1.0000]
aParS[2][4] -> N ( 15) [ 1.0000]
aParS[2][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[3] -> ARRAY ( 5) [...]
aParS[3][1] -> N ( 15) [ 2.0000]
aParS[3][2] -> C ( 6) [NASCIM]
aParS[3][3] -> N ( 15) [ 1.0000]
aParS[3][4] -> N ( 15) [ 1.0000]
aParS[3][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[4] -> ARRAY ( 5) [...]
aParS[4][1] -> N ( 15) [ 3.0000]
aParS[4][2] -> C ( 4) [NOME]
aParS[4][3] -> N ( 15) [ 1.0000]
aParS[4][4] -> N ( 15) [ 1.0000]
aParS[4][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[5] -> ARRAY ( 5) [...]
aParS[5][1] -> N ( 15) [ 4.0000]
aParS[5][2] -> C ( 6) [PESOKG]
aParS[5][3] -> N ( 15) [ 0.0000]
aParS[5][4] -> N ( 15) [ 1.0000]
aParS[5][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[6] -> ARRAY ( 5) [...]
aParS[6][1] -> N ( 15) [ 5.0000]
aParS[6][2] -> C ( 6) [ALTURA]
aParS[6][3] -> N ( 15) [ 0.0000]
aParS[6][4] -> N ( 15) [ 1.0000]
aParS[6][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[7] -> ARRAY ( 5) [...]
aParS[7][1] -> N ( 15) [ 6.0000]
aParS[7][2] -> C ( 3) [CPF]
aParS[7][3] -> N ( 15) [ 1.0000]
aParS[7][4] -> N ( 15) [ 1.0000]
aParS[7][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[8] -> ARRAY ( 5) [...]
aParS[8][1] -> N ( 15) [ 7.0000]
aParS[8][2] -> C ( 6) [NASCIM]
aParS[8][3] -> N ( 15) [ 1.0000]
aParS[8][4] -> N ( 15) [ 1.0000]
aParS[8][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[9] -> ARRAY ( 5) [...]
aParS[9][1] -> N ( 15) [ 8.0000]
aParS[9][2] -> C ( 4) [NOME]
aParS[9][3] -> N ( 15) [ 1.0000]
aParS[9][4] -> N ( 15) [ 1.0000]
aParS[9][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[10] -> ARRAY ( 5) [...]
aParS[10][1] -> N ( 15) [ 9.0000]
aParS[10][2] -> C ( 6) [PESOKG]
aParS[10][3] -> N ( 15) [ 0.0000]
aParS[10][4] -> N ( 15) [ 1.0000]
aParS[10][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[11] -> ARRAY ( 5) [...]
aParS[11][1] -> N ( 15) [ 10.0000]
aParS[11][2] -> C ( 9) [DESCRICAO]
aParS[11][3] -> N ( 15) [ 1.0000]
aParS[11][4] -> N ( 15) [ 1.0000]
aParS[11][5] -> C ( 21) [INCLUIR#1.TORNEIOIN#1]
aParS[12] -> ARRAY ( 5) [...]
aParS[12][1] -> N ( 15) [ 11.0000]
aParS[12][2] -> C ( 5) [FINAL]
aParS[12][3] -> N ( 15) [ 1.0000]
aParS[12][4] -> N ( 15) [ 1.0000]
aParS[12][5] -> C ( 21) [INCLUIR#1.TORNEIOIN#1]
aParS[13] -> ARRAY ( 5) [...]
aParS[13][1] -> N ( 15) [ 12.0000]
aParS[13][2] -> C ( 6) [INICIO]
aParS[13][3] -> N ( 15) [ 1.0000]
aParS[13][4] -> N ( 15) [ 1.0000]
aParS[13][5] -> C ( 21) [INCLUIR#1.TORNEIOIN#1]
*/
// Analisando o array acima, vemos que os parametros de primeiro nivel
// sao INICIO, FINAL e DESCRICAO. Logo, podemos alimentar estes valores
// diretamente, inclusive pelo nome. Porem precisamos informar tambem o array contendo 
// a sequencia de elementos "pai" de cada valor. Na pratica, pasta pegar a 
// lista de elementos pai identificada no 5o elemento do array de simpleInput
// e criar um array com ele.
lOk := oWsdl:SetValPar("DESCRICAO",{"INCLUIR#1","TORNEIOIN#1"}, "Torneio de Testes")
if !lOk
 MsgStop( oWsdl:cError , procline())
 Return
endif
lOk := oWsdl:SetValPar("INICIO",{"INCLUIR#1","TORNEIOIN#1"}, '20150701')
if !lOk
 MsgStop( oWsdl:cError , procline())
 Return
endif
lOk := oWsdl:SetValPar("FINAL",{"INCLUIR#1","TORNEIOIN#1"}, '20150702')
if !lOk
 MsgStop( oWsdl:cError , procline())
 Return
endif
// Podemos ver tambem que o array de tipos simples foi criado para 2 atletas
// e agora temos IDs para cada um deles. Isto somente aconteceu pois 
// usamos o metodo SetComplexOccurs(). Caso nao tivessemos utilizado 
// este metodo, o array de estruturas simples viria apenas com os 
// identificadores para inserir um altleta.
// Para definir os tipos complexos, uma vez que seus valores
// já estão enumerados na lista de tipos simples, podemos fazer assim :
aParent := {"INCLUIR#1","TORNEIOIN#1","ATLETAS#1","ATLETA#1"}
oWsdl:SetValPar("NOME",aParent,"Romualdo da Silva")
oWsdl:SetValPar("CPF",aParent,"123456789-01")
oWsdl:SetValPar("NASCIM",aParent,"1974-05-08")
oWsdl:SetValPar("PESOKG",aParent,"77,5")
oWsdl:SetValPar("ALTURA",aParent,"1,85")
// Como os atletas são inseridos em sequencia, basta informarmos
// a que alteta a informação se destina, variando o ultimo
// elemento do array dos "pais" de cada informação.
aParent := {"INCLUIR#1","TORNEIOIN#1","ATLETAS#1","ATLETA#2"}
oWsdl:SetValPar("NOME",aParent,"Sinfronio da Silva")
oWsdl:SetValPar("CPF",aParent,"555555555-55")
oWsdl:SetValPar("NASCIM",aParent,"1976-03-12")
oWsdl:SetValPar("PESOKG",aParent,"66,5")
oWsdl:SetValPar("ALTURA",aParent,"1,65")
// Agora executamos a requisição ao WebService
lOk := oWsdl:SendSoapMsg()
if !lOk
 MsgStop( oWsdl:cError , "SendSoapMsg() ERROR")
 Return
endif
// mostra no console o XML Soap devolvido
conout( "--- SOAP RESPONSE ---" , oWsdl:GetSoapResponse() , "-------------------")
// Recupera os elementos de retorno, já parseados
cResp := oWsdl:GetParsedResponse()
/*
Como o retorno é apenas um numero, podemos obtelo diretamente 
parseando a string retornada em cResp
*/
varinfo("cResp",cResp)
Return

Conclusão

A classe tWSDLManager tem uma sequência de operações que precisa ser realizada antes de começar a alimentar as propriedades de envio de dados. Caso existam mais informações que possuem quantidades variáveis, é necessário definir a quantidade de cada uma delas antes de começar a popular os valores para realizar a requisição / chamada do WebService.

Para o próximo post sobre Web Services, eu vou pegar este exemplo didático, e fazer um método de consulta, onde o retorno do Web SErvices server vai ser as informações de um torneio. Esta etapa de tratamento de retorno de tipos complexos é muito simples usando a geração do fonte client em AdvPL, mas é um pouco mais complicada quando usamos a classe tWSDLManager(), e realmente tudo isso de uma vez dentro de apenas uma postagem, ficaria muito grande !

Até a próxima pessoal, e bons Web Services 😀

Imagens no SGDB via DBAccess

Introdução

Recebi um e-mail, ou mensagem, ou post (não lembro agora) com uma sugestão interessante, para este tema (Imagens no SGDB) fosse abordado aqui no Blog. E, é totalmente possível de ser feito, de forma relativamente simples.

Imagens, por dentro

Um arquivo em disco que contém uma imagem pode ser salvo em diversos formatos: BMP (Bitmap Image File), JPEG (Joint Photographic Experts Group), PNG (Portable Network Graphics), entre outros. Cada formato consiste em uma especificação para a representação binária de uma imagem. Trocando em miúdos, um arquivo de imagem contém um determinado número de bytes, usando códigos ASCII de 0 a 255 (conteúdo binário), que são interpretados por uma aplicação capaz de mostrar seu conteúdo em uma interface. Cada tipo de imagem possui algumas características, como resolução, compressão, mas por dentro são apenas uma sequência de bytes.

Imagens no SGDB

Existem bancos de dados que possuem um tipo de campo próprio para imagens, como o Microsoft SQL Server (campo image), mas a grosso modo praticamente todos os bancos de dados comerciais possuem um tipo de campo conhecido por “BLOB” (Binary Large OBject), capaz de suportar conteúdo binário.

Acesso pelo DBAccess

Como é de conhecimento de todos que trabalham com o ERP Microsiga, todo o accesso a Banco de Dados relacional no Protheus é feito através do DBAccess, um gateway de acesso para bancos relacionais, que também é capaz de emular o acesso ISAM, ainda usado por boa parte do código legado do ERP.

O DBAccess não permite acesso direto a campos IMAGE, BLOB ou CLOB, mas internamente ele se utiliza destes campos para emular o campo do tipo “M” memo do AdvPL. Logo, para nos utilizarmos destes tipos de campo, devemos criar uma tabela no SGDB usando o tipo de campo “M” (Memo) do AdvPL.

Atenção, no ERP existe o conceito de campo Memo virtual, criado no dicionário de dados do ERP (SX3), que na prática utiliza um arquivo auxiliar (SYP) na Base de Dados principal, com acesso através de uma API Advpl, ao qual esse exemplo não se aplica. O campo Memo que será criado é um Memo “real” no SGDB.

Características e Limites

O AdvPL possui um limite de 1MB de tamanho máximo de String, logo ainda não é possível armazenar no SGDB uma imagem maior que isso. E, como o acesso ao conteúdo do campo é feito pelo DBAccess, não é possível fazer uma Query que recupere diretamente o conteúdo de um campo BLOB, CLOB ou IMAGE.

Para acessar o conteúdo de um campo “M” Memo criado em uma tabela, devemos abrir a tabela no AdvPL usando DbUseArea() — ou ChkFile(), para uma tabela de dados do ERP –, posicionar no registro desejado e ler o valor do campo do registro atual através da expressão cVARIAVEL := ALIAS->CAMPOMEMO, e o DBAccess irá fazer uma requisição exclusiva para trazer o conteúdo deste campo e colocá-lo na variável de memória.

Adicionalmente, o campo “M” Memo originalmente no AdvPL foi projetado para suportar apenas 64 KB de dados, e somente conseguimos aumentar esse limite para 1MB habilitando a configuração TOPMEMOMEGA=1 na configuração do environment desejado no arquivo de configuração do TOTVS Application Server (appserver.ini) — Vide TDN, no link http://tdn.totvs.com/pages/viewpage.action?pageId=6065746 )

Como as imagens gravadas costumam ser bem maiores que os registros gravados em tabelas de dados do ERP, deve-se tomar cuidado quando a leitura destes campos for realizada por muitos processos simultaneamente, isto pode gerar um gargalo na camada de rede entre as aplicações TOTVS Application Server, DBACcess e o SGDB.

E, existem alguns bancos de dados homologados que por default não se utilizam de campos BLOB ou similares para armazenar os dados de campo “M” Memo. Para ter certeza que a implementação vai funcionar em todos os bancos homologados, podemos limitar o tamanho da imagem em 745 KB, e converter o buffer binário da imágem para BASE64, onde são usadas strings de texto normal para a representação dos dados, e fazer as conversões em memória para Ler e Gravar o buffer binário.

Mãos à obra

Basicamente, armazenar uma imagem no SGDB requer no mínimo 2 campos na tabela de imagens: Um campo caractere, identificador único da imagem, indexado, e um campo “M” Memo do AdvPL, para armazenar a imagem. Podemos encapsular isso em uma classe — vamos chamá-la ApDbImage() — e implementar os métodos de leitura e gravação, manutenção e status, além de dois métodos adicionais para ler imagens de um arquivo no disco para a memória, e gravar a imagem da memória para o disco.

A classe APDBIMAGE() foi implementada com este propósito, mas ela têm ainda alguns detalhes adicionais, ela guarda um HASH MD5 gerado a partir da imagem original, um campo separado para o tipo da imagem, e permite as operações básicas de inclusão, leitura, alteração e exclusão.

Exemplo de uso e fontes

O programa de exemplo funciona como um manager simples de imagens, permitindo abrir os formatos suportados de imagens do disco, para serem mostrados na tela, ou do próprio repositório, ou também da tabela de imagens do Banco de Dados. Uma vez visualizada uma imagem na interface, ela pode ser gravada em disco (ou exportada), no mesmo formato que foi aberto — o programa não realiza conversões — , e também pode ser inserida no DBimage com um nome identificador qualquer, ou usada para alterar uma imagem já existente na tabela de imagens.

O fonte da classe APDBImage() pode ser baixado no link https://github.com/siga0984/Blog/blob/master/ApDBImage.prw , e o fonte de exemplo que usa a classe está no link https://github.com/siga0984/Blog/blob/master/TSTDBIMG.prw , ambos no GitHub do Blog ( https://github.com/siga0984/blog ). Basta baixar os fontes, compilá-los com o IDE ou o TDS, e executar a função U_TSTDBIMG para acionar o programa de testes da classe ApDbImage().

E, para os curiosos e ávidos por código, segue o fonte da Classe APDBIMAGE logo abaixo:

#include "protheus.ch"
/* ---------------------------------------------------
Classe ApDBImage
Autor Júlio Wittwer
Data 27/02/2015 
Versão 1.150308
Descrição Classe para encapsular leitura e gravação de 
 imagens em tabela do SGDB através do DBACCESS
Observação
Como apenas o banco MSSQL aceita conteúdo binário ( ASCII 0 a 255 )
para campos MEMO, e os bancos ORACLE e DB2 ( quando usado BLOB ), 
para servir para todos os bancos, a imagem é gravada no banco 
usando Encode64 -- para converter conteúdo binário em Texto 
codificado em Base64, a maior imagem nao pode ter mais de 745000 bytes
Referências
http://tdn.totvs.com/display/tec/Acesso+ao+banco+de+dados+via+DBAccess
http://tdn.totvs.com/pages/viewpage.action?pageId=6063692
http://tdn.totvs.com/display/tec/Encode64
http://tdn.totvs.com/display/tec/Decode64
--------------------------------------------------- */
#define MAX_IMAGE_SIZE 745000
CLASS APDBIMAGE
// Propriedades
 DATA bOpened 
 DATA cError
// Métodos 
 METHOD New() 
 METHOD Open()
 METHOD Close() 
 METHOD ReadStr( cImgId , /* @ */ cImgType , /* @ */ cImgBuffer ) 
 METHOD Insert( cImgId , cImgType , /* @ */ cImgBuffer ) 
 METHOD Update( cImgId , cImgType , /* @ */ cImgBuffer ) 
 METHOD Delete( cImgId ) 
 METHOD Status()
// Metodos de acesso de imagens no disco
 METHOD LoadFrom( cFile, cImgBuffer )
 METHOD SaveTo( cFile, cImgBuffer )
 
ENDCLASS
/* ---------------------------------------------------------
Construtor da classe de Imagens no SGDB
Apenas inicializa propriedades
-------------------------------------------------------- */
METHOD New() CLASS APDBIMAGE
::bOpened := .F.
::cError := ''
Return self
/* ---------------------------------------------------------
Abre a tabela de imagens no SGDB
Conecta no DBAccess caso nao haja conexão
--------------------------------------------------------- */
METHOD Open( ) CLASS APDBIMAGE
Local nDBHnd := -1
Local aStru := {}
Local cOldAlias := Alias()
::cError := ''
IF ::bOpened 
 // Ja estava aberto, retorna direto
 Return .T.
Endif
If !TcIsConnected() 
 // Se não tem conexão com o DBAccess, cria uma agora
 // Utiliza as configurações default do appserver.ini
 nDBHnd := tcLink()
 If nDBHnd < 0
 ::cError := "TcLink() error "+cValToChar(nDbHnd)
 Return .F.
 Endif
Endif
If !TCCanOpen("ZDBIMAGE")
 
 // Cria array com a estrutura da tabela
 aAdd(aStru,{"ZDB_IMGID" ,"C",40,0})
 aAdd(aStru,{"ZDB_TYPE" ,"C",3,0}) // BMP JPG PNG 
 aAdd(aStru,{"ZDB_HASH" ,"C",32,0}) 
 aAdd(aStru,{"ZDB_SIZE" ,"N",8,0})
 aAdd(aStru,{"ZDB_MEMO" ,"M",10,0})
// Cria a tabela direto no SGDB
 DBCreate("ZDBIMAGE",aStru,"TOPCONN")
 
 // Abre em modo exclusivo para criar o índice de ID
 USE ("ZDBIMAGE") ALIAS ZDBIMAGE EXCLUSIVE NEW VIA "TOPCONN"
 
 If NetErr()
 ::cError := "Failed to open [ZDBIMAGE] on EXCLUSIVE Mode"
 Return
 Endif
 
 // Cria o índice por ID da imagem 
 INDEX ON ZDB_IMGID TO ("ZDBIMAGE1")
 
 // Fecha a tabela
 USE
 
Endif
 
// Abre em modo compartilhado
USE ("ZDBIMAGE") ALIAS ZDBIMAGE SHARED NEW VIA "TOPCONN"
If NetErr()
 ::cError := "Failed to open [ZDBIMAGE] on SHARED Mode"
 Return .F.
Endif
DbSetIndex("ZDBIMAGE1")
DbSetOrder(1)
::bOpened := .T.
If !Empty(cOldAlias) .and. Select(cOldAlias) > 0
 DbSelectArea(cOldAlias)
Endif
Return ::bOpened
/* ---------------------------------------------------------
Le uma imagem do banco para a memoria
recebe o nome da imgem, retorna por referencia o tipo
da imagem e seu conteudo 
-------------------------------------------------------- */
METHOD ReadStr( cImgId , /* @ */cImgType, /* @ */ cImgBuffer ) CLASS APDBIMAGE
::cError := ''
If !::bOpened
 ::cError := "APDBIMAGE:ReadStr() Error: Instance not opened."
 Return .F.
Endif
If empty(cImgId)
 ::cError := "APDBIMAGE:ReadStr() Error: ImageId not specified."
 Return .F. 
Endif
cImgId := Lower(cImgId)
If !ZDBIMAGE->(DbSeek(cImgId))
 ::cError := "APDBIMAGE:ReadStr() ImageId ["+cImgId+"] not found."
 Return .F.
Endif
// Caso a imagem com o ID informado seja encontrada
// Carrega o buffer da imagem para a variável de memória
cImgBuffer := Decode64(ZDBIMAGE->ZDB_MEMO)
cImgType := ZDBIMAGE->ZDB_TYPE
Return .T.
/* ---------------------------------------------------------
Insere uma imagem na tabela de imagens do SGDB
Recebe o ID da imagem, o tipo e o buffer 
-------------------------------------------------------- */
METHOD Insert( cImgId , cImgType, cImgBuffer ) CLASS APDBIMAGE
Local bOk := .F.
::cError := ''
If !::bOpened
 ::cError := "APDBIMAGE:Insert() Error: Instance not opened."
 Return .F. 
Endif
If empty(cImgId)
 ::cError := "APDBIMAGE:Insert() Error: ImageId not specified."
 Return .F. 
Endif
If empty(cImgType)
 ::cError := "APDBIMAGE:Insert() Error: ImageType not specified."
 Return .F. 
Endif
cImgId := Lower(cImgId)
cImgType := Lower(cImgType)
If !ZDBIMAGE->(DbSeek(cImgId))
 // Se a imagem não existe, insere
 ZDBIMAGE->(DBAppend(.T.))
 ZDBIMAGE->ZDB_IMGID := cImgId
 ZDBIMAGE->ZDB_TYPE := cImgType
 ZDBIMAGE->ZDB_SIZE := len(cImgBuffer)
 ZDBIMAGE->ZDB_HASH := Md5(cImgBuffer,2) // Hash String Hexadecimal
 ZDBIMAGE->ZDB_MEMO := Encode64(cImgBuffer)
 ZDBIMAGE->(DBRUnlock())
 bOk := .T.
else
 ::cError := 'Image Id ['+cImgId+'] already exists.'
Endif
Return bOk
/* ---------------------------------------------------------
Atualiza uma imagem ja existente no banco de imagens
Recebe ID, tipo e buffer
-------------------------------------------------------- */
METHOD Update( cImgId , cImgType, cImgBuffer ) CLASS APDBIMAGE
::cError := ''
If !::bOpened
 ::cError := "APDBIMAGE:Update() Error: Instance not opened."
 Return .F. 
Endif
If empty(cImgId)
 ::cError := "APDBIMAGE:Update() Error: ImageId not specified."
 Return .F. 
Endif
If empty(cImgType)
 ::cError := "APDBIMAGE:Update() Error: ImageType not specified."
 Return .F. 
Endif
cImgId := Lower(cImgId)
cImgType := Lower(cImgType)
 
If !ZDBIMAGE->(DbSeek(cImgId))
 ::cError := 'Image Id ['+cImgId+'] not found.'
 Return .F.
Endif
// Se a imagem existe, atualiza
IF !ZDBIMAGE->(DbrLock(recno()))
 ::cError := 'Image Id ['+cImgId+'] update lock failed.'
 Return .F.
Endif
ZDBIMAGE->ZDB_TYPE := cImgType
ZDBIMAGE->ZDB_SIZE := len(cImgBuffer)
ZDBIMAGE->ZDB_HASH := MD5(cImgBuffer,2) // Hash String Hexadecimal
ZDBIMAGE->ZDB_MEMO := Encode64(cImgBuffer)
ZDBIMAGE->(DBRUnlock())
Return .T.
/* ---------------------------------------------------------
Deleta fisicamente uma imagem da Tabela de Imagens
-------------------------------------------------------- */
METHOD Delete( cImgId , lHard ) CLASS APDBIMAGE
Local nRecNo
::cError := ''
If !::bOpened
 ::cError := "APDBIMAGE:Delete() Error: Instance not opened."
 Return .F. 
Endif
If empty(cImgId)
 ::cError := "APDBIMAGE:Delete() Error: ImageId not specified."
 Return .F. 
Endif
If !ZDBIMAGE->(DbSeek(cImgId))
 ::cError := 'Image Id ['+cImgId+'] not found.'
 Return .F.
Endif
// Se a imagem existe, marca o registro para deleção
nRecNo := ZDBIMAGE->(recno())
// Mesmo que a deleção seja fisica, eu garanto 
// o lock do registro na camada do dbaccess
If !ZDBIMAGE->(DbrLock(nRecNo))
 ::cError := 'Image Id ['+cImgId+'] delete lock failed.'
 Return .F.
Endif
// Deleta fisicamente no SGBD
nErr := TcSqlExec("DELETE FROM ZDBIMAGE WHERE R_E_C_N_O_ = " + cValToChar(nRecNo) )
If nErr < 0
 ::cError := 'Image Id ['+cImgId+'] delete error: '+TcSqlError()
Endif
// Solto o lock do registro no DBAccess
ZDBIMAGE->(DBRUnlock())
Return .T.
/* ---------------------------------------------------------
Fecha a tabela de imagens
-------------------------------------------------------- */
METHOD Close() CLASS APDBIMAGE
If Select('ZDBIMAGE') > 0
 ZDBIMAGE->(DbCloseArea())
Endif
::cError := '' 
::bOpened := .F.
Return .T.
/* ---------------------------------------------------------
Metodo Status()
Classe APDBIMAGE
Descrição Monta array por referencia contendo as informações da base 
 de imagens: Quantidade de registros total, tamanho estimado 
 total das imagens, quantidade de registros marcados para 
 deleção e tamanho estimado de imagens marcadas para deleçao 
-------------------------------------------------------- */
METHOD Status( /* @ */ aStat ) CLASS APDBIMAGE
Local cOldAlias := Alias()
Local cQuery 
Local nCountAll := 0
Local nSizeAll := 0
::cError := '' 
aStat := {}
If !::bOpened
 ::cError := "APDBIMAGE:Status() Error: Instance not opened."
 Return .F. 
Endif
// Conta quantas imagens tem na tabela, por tipo 
cQuery := "SELECT ZDB_TYPE, count(*) AS TOTAL"+;
 " FROM ZDBIMAGE GROUP BY ZDB_TYPE ORDER BY ZDB_TYPE"
 
USE (TcGenQry(,,cQuery)) ALIAS QRY EXCLUSIVE NEW VIA "TOPCONN"
While !eof()
 aadd(aStat , {"TOTAL_COUNT_"+QRY->ZDB_TYPE,QRY->TOTAL})
 nCountAll += QRY->TOTAL
 DbSkip()
Enddo
USE
// Acrescenta total de imagens
aadd(aStat , {"TOTAL_COUNT_ALL",nCountAll})
 
// Levanta o total de bytes usados por tipo de imagem
cQuery := "SELECT ZDB_TYPE, SUM(ZDB_SIZE) AS TOTAL"+;
 " FROM ZDBIMAGE GROUP BY ZDB_TYPE ORDER BY ZDB_TYPE"
 
USE (TcGenQry(,,cQuery)) ALIAS QRY EXCLUSIVE NEW VIA "TOPCONN"
While !eof()
 aadd(aStat , {"TOTAL_SIZE_"+QRY->ZDB_TYPE,QRY->TOTAL})
 nSizeAll += QRY->TOTAL
 DbSkip()
Enddo
USE
// Acrescenta total de bytes usados 
aadd(aStat , {"TOTAL_SIZE_ALL",nSizeAll})
If !Empty(cOldAlias)
 DbSelectArea(cOldAlias)
Endif
Return .T.
/* ---------------------------------------------------------
Ler um arquivo de imagem do disco para a memoria
Nao requer que a instancia esteja inicializada / Aberta
--------------------------------------------------------- */
METHOD LoadFrom( cFile, /* @ */ cImgBuffer ) CLASS APDBIMAGE
Local nH, nSize, nRead
::cError := ''
If !file(cFile)
 ::cError := "APDBIMAGE:LoadFrom() Error: File ["+cFile+"]not found."
 Return .F. 
Endif
nH := Fopen(cFile,0)
If nH == -1 
 ::cError := "APDBIMAGE:LoadFrom() File Open Error ( FERROR "+cValToChar( Ferror() )+")" 
 Return .F. 
Endif
nSize := fSeek(nH,0,2)
fSeek(nH,0)
If nSize <= 0 
 ::cError := "APDBIMAGE:LoadFrom() File Size Error : Empty File" 
 fClose(nH)
 Return .F. 
Endif
If nSize > MAX_IMAGE_SIZE
 ::cError := "APDBIMAGE:LoadFrom() File TOO BIG ("+ cValToChar(nSize) +" bytes)" 
 fClose(nH)
 Return .F. 
Endif
// Aloca buffer para ler o arquivo do disco 
// e le o arquivo para a memoria
cImgBuffer := space(nSize)
nRead := fRead(nH,@cImgBuffer,nSize)
// e fecha o arquivo no disco 
fClose(nH)
If nRead < nSize
 cImgBuffer := ''
 ::cError := "APDBIMAGE:LoadFrom() Read Error ( FERROR "+cValToChar( Ferror() )+")" 
 Return .F. 
Endif
Return .T.
/* ---------------------------------------------------------
Gravar um arquivo de imagem no disco a partir de uma imagem na memoria
Nao requer que a instancia esteja inicializada / Aberta
--------------------------------------------------------- */
METHOD SaveTo( cFile, cImgBuffer ) CLASS APDBIMAGE
Local nH, nSize , nSaved 
::cError := ''
If file(cFile)
 ::cError := "APDBIMAGE:SaveTo() Error: File ["+cFile+"] alreay exists."
 Return .F. 
Endif
// Cria o arquivo no disco 
nH := fCreate(cFile)
If nH == -1 
 ::cError := "APDBIMAGE:SaveTo() File Create Error ( FERROR "+cValToChar( Ferror() )+")" 
 Return .F. 
Endif
 
// Calcula tamanho do buffer de memoria
// e grava ele no arquivo 
nSize := len(cImgBuffer)
nSaved := fWrite(nH,cImgBuffer)
// Fecha o arquivo 
fClose(nH)
If nSaved < nSize
 ::cError := "APDBIMAGE:SaveTo() Write Error ( FERROR "+cValToChar( Ferror() )+")" 
 Return .F. 
Endif
Return .T.
Conclusão

Esta classe é só um esboço, com alguns parafusos a mais ela pode ser usada para construir um assistente para, por exemplo, importar uma pasta cheia de imagens para o banco de dados, dando o nome das imagens automaticamente baseado no nome do arquivo original, e o fato dela gerar o MD5 Hash a partir do buffer binário original pode permitir uma busca mais rápida por imagens idênticas repetidas dentro do banco, fazendo apenas uma Query para mostrar quais os ImageID´s que possuem o mesmo HASH !!!

Pessoal, novamente agradeço a audiência, espero que gostem do Post. Já tenho alguma coisa no forno para os próximos posts, mas continuo aceitando sugestões !! Até o próximo post, pessoal 😉

Classes em Advpl – Parte 04

E, para finalizar a a introdução do tópico “Classes em Advpl”, hoje vamos abordar algumas boas práticas da orientação a objeto, com foco no uso com ADVPL.

Simplicidade

A correta representação do domínio do problema deve ser simples, mesmo para um problema complexo. Por exemplo, fazer um jogo de damas ou xadrez no computador pode parecer algo muito complexo, certo ? Com apenas uma classe de tabuleiro, uma classe de jogador, uma classe base (ou abstrata) para uma peça genérica, e uma classe para cada peça do tabuleiro, onde a instância de tabuleiro é responsável por fazer a interface com o usuário e permitir ele mover uma peça de um lugar de origem para um lugar de destino, eu garanto que fica mais simples. A interface recebe o input do jogador, e aciona o método de mover peça do tabuleiro, que verifica se tem uma peça na posição de origem, e chama um método da peça para listar as posições válidas para onde a peça pode ser movida. Cada objeto tem a sua camada de inteligência (métodos) e validações.

A implementação feita desta forma fica isolada em cada peça, afinal você precisa escrever apenas um método para cada peça para determinar as posições possiveis de movimento a partir do tabuleiro em um determinado estado, onde um metodo do tabuleiro se encarrega de varrer a lista de peças em jogo de um dos jogadores e perguntar para cada uma para onde ela pode mover-se. Com isso é mais fácil implementar a mecânica dos movimentos das peças, e até um mecanismo de projeção de movimentos possíveis do adversário.

Nível de abstração e herança adequadas

Quanto maior o detalhamento que você precisa, maior será a quantidade de classes e propriedades necessárias para lhe atender. Atenha-se ao que você precisa, e de forma ordenada. Por exemplo, ao prototipar três classes, A , B, e C, onde B e C herdam A, na classe superior (A) você deve colocar propriedades que são comuns a todas as classes da herança, e nas classes filhas apenas as propriedades e métodos específicos que somente caberiam na instância da classe filha, permanecendo os métodos comuns na classe pai. Muitas vezes implementamos uma herança sem ter propriedades específicas, mas implementações de métodos com comportamentos diferenciados por instância.

Destrutores e limpeza de memória

Uma instância de uma classe na linguagem ADVPL não possui declaração explícita de métodos destrutores, porém o kernel do ADVPL realiza um controle de reaproveitamento de memória da instância da classe, e mantém a instância na memória, mesmo que ela não seja mais referenciável, apenas eliminando a memória consumida pela instância quando a função que cria a instância da classe é chamado e cria uma nova instância. A memória ocupada pela instância envolve todas as propriedades da instância.

Logo, é elegante e saudável para a memória você criar um método “CleanUp” na classe para limpar as propriedades que não estão sendo mais referenciadas desta instância, uma vez que a mesma não seja mais necessária, e após chamar o CleanUp() da instância, você executa a função FreeObj(), passando a variável que contém a instância como parâmetro.

Se você executar um FreeObj() em uma instância de classe ADVPL, mas ela ainda estava sendo referenciada em uma ou mais varíaveis ou propriedades de outras classes, automaticamente estas referências tornam-se nulas (NIL). Caso algum programa tente acessá-las, será gerada uma ocorrência de erro “Variable is not an object”.

A função FreeObj() também serve para eliminar uma classe da interface visual do Advpl. Neste caso, muito cuidado com o seu uso, pois se você por exemplo executar um FreeObj() em uma instância de tWindow, tDialog, tPanel, ou qualquer instância de container de interface, que está ativa na tela e na pilha de execuções, você pode provocar uma invasão de memória ( Access Violation ou Segment Fault ).

A dica de limpeza vale também para funções em Advpl, onde as variáveis locais daquela execução permanecem alocadas na memória, somente sendo desalocadas em uma próxima execução da função. Por exemplo, uma função de processamento intermediário cria um array local dentro do fonte, e popula este array para fazer um cálculo. Se o retorno desta função não for o próprio array, o conteúdo alocado na memória pelos elementos não será necessário e nem acessível quando a função retornar o valor calculado, mas a área de memória ocupada vai permanecer alocada. Neste caso, você deve limpar o array, usando a função de redimensionamento de array da seguinte forma: aSize(aVarArray,0) — onde aVarArray é a variável que contém o array a ser limpo.

Caso as propriedades da classe apontem para arrays de outros objetos, que estão compartilhados com outros componentes e não exatamente devem ser destruídos, é interessante e elegante que você atribua NIL nestas propriedades, para elas deixarem de referenciar os arrays e objetos em questão.

Performance

Existe um overhead na performance na chamada de um método, em comparação com a chamada de uma função. Fiz um teste de performance de chamadas de uma função e de um método de classe, onde a função e a classe realizam um processamento – o retorno de um valor constante. O loop de processamento demorou em média 1,5 segundos para chamar um milhão de vezes uma função, e demorou 3,8 segundos para chamar um milhão de vezes um método. Parece uma grande diferença, certo ? Bem, estamos falando aqui de 666 mil RPS(requisições por segundo) de função, contra 263 mil RPS em chamadas de método, usando uma CPU de 1.8 GHZ.

Lembre-se da Lei de Amdahl, já mencionada aqui em outra postagem sobre escalabilidade e performance: “O ganho de desempenho que pode ser obtido melhorando uma determinada parte do sistema é limitado pela fração de tempo que essa parte é utilizada pelo sistema durante a sua operação.” Logo, a relevância do tempo em uma etapa específica de um processo somente é perceptível caso ela seja representativa no tempo total do processo.

Por exemplo, em uma rotina de processamento onde os métodos realizam tarefas, decisões e manipulações de dados e propriedades, e podem acessar banco de dados ou informações no disco, o tempo de processamento do método vai ser muito maior do que o tempo da chamada. Ao calcularmos o tempo total de processamento de 1 milhão de requisições de um determinado método, onde cada requisição demora em média 1/10 de segundo, serão 166 minutos (duas horas e 46 minutos) de processamento, mais quatro segundos do tempo gasto com as chamadas dos métodos. Se este loop fosse feito com chamadas de função, acrescentaríamos ao tempo total apenas 1,5 segundo. Esta diferença de tempo, em um processo de 166 minutos, não quer dizer nada.

Este overhead somente torna-se significativo quando os métodos são extremamente curtos, como por exemplo operações aritméticas ou apenas encapsulamento para retorno de propriedades. E mesmo assim, são necessárias milhões de requisições para isso tornar-se perceptível.

Conclusão

A orientação a objetos é um paradigma muito interessante de ser explorado, mas como toda a solução em tecnologia da informação, existem casos onde uma abordagem com funções pode ser mais interessante, até mesmo dentro do mesmo aplicativo. Prevalece sempre a análise de caso, use um paradigma ou abordagem para resolver os problemas onde ela apresenta a melhor relação custo x benefício.

Posteriormente eu devo voltar no tema de orientação a objetos, focando mais em exemplos práticos e casos de uso em ADVPL.

Até o próximo post, pessoal 😉

Classes em Advpl – Parte 03

No tópico anterior, vimos um exemplo de uma classe ADVPL herdando outra classe em ADVPL. Vimos também que a herança não pode ser múltipla, isto é, uma classe não pode herdar mais de uma classe pai ao mesmo tempo, e vimos também que é possível herdar uma classe que já possua herança. Agora, vamos criar uma classe ADVPL que herda uma classe básica da linguagem. Vamos criar uma classe de botão diferenciada, herdando a classe básica de botão do ADVPL (tButton).

Desta vez sem muita teoria, os dois tópicos anteriores já cuidaram dessa parte ! Agora, as explicações ficam pro final do tópico, vamos ao código: Crie um fonte novo (extensão .PRW), copie, cole, salve, compile e execute U_APTST03 através do Smartclient.

// --------------------------------------------------
// Fonte de teste da classe APBUTTON herdando tButton
User Function APPTST03() 
Local oDlg , oBtn1, oBtn2
DEFINE DIALOG oDlg TITLE "Exemplo de Herança" FROM 10,10 TO 150,300 COLOR CLR_BLACK,CLR_WHITE PIXEL
// Cria um botao normal
// e seta cor diferenciada para o botão 
@ 10,5 BUTTON oBtn1 PROMPT 'TBUTTON' ;
 ACTION ( oBtn2:Show() , oBtn1:Hide() ) ;
 SIZE 040, 013 OF oDlg PIXEL
// Cria um botao usando a classe implementada
oBtn2 := APBUTTON():NEW(oDlg, "APBUTTON", 30, 5, 40, 13, {|| oBtn1:Show(),oBtn2:Hide() })
ACTIVATE DIALOG oDlg CENTER
Return
// ------------------------------------------------------------
CLASS APBUTTON FROM TBUTTON
METHOD New() CONSTRUCTOR
 METHOD Hide()
 METHOD Show()
 
ENDCLASS
// Construtor da classe inicializa construtor do botão 
// e já seta todas as propriedades e comportamentos desejados
// ( Troca fonte, seta cor e esconde o botão ) 
METHOD New(oParent,cCaption,nTop,nLeft,nWidth,nHeight,bAction) CLASS APBUTTON
:New(nTop,nLeft,cCaption,oParent,bAction,nWidth,nHeight,NIL,NIL,NIL,.T.)
::SetColor(CLR_WHITE,CLR_BLACK)
::SetFont( TFont():New("Courier New",,14))
_Super:Hide()
Return self
METHOD Hide() CLASS APBUTTON
MsgInfo("Escondendo o botão ["+::cCaption+"]")
Return _Super:Hide()
METHOD Show() CLASS APBUTTON
MsgInfo("Mostrando o botão ["+::cCaption+"]")
Return _Super:Show()

As diferenças

Os dois botões são criados de formas diferentes, o botão oBtn1 usando a definição padrão do ADVPL, e o oBtn2 usando a nossa classe APBUTTON, que herda TBUTTON. A primeira diferença é o construtor. A herança de classe básica do ADVPL exige que a primeira linha do método construtor chame o construtor da classe pai da herança, usando apenas “:”+nomedoconstrutor+”(“+parâmetros+”)” . A utilização da diretiva “_Super:” dentro da implementação dos métodos funciona da mesma forma, exceto para a chamada do construtor, que exige a grafia diferenciada.

Ao executar o programa acima, devemos ver um botão do ADVPL, que ao ser clicado mostra o novo botão APBUTTON e esconde o botão pressionado. Antes de mostrar o novo botão, como o método Hide() foi reimplementado, será mostrada uma mensagem informativa. A mesma coisa acontece para o método Show(), porém apenas do botão implementado com a classe APBUTTON. A ação do botão APBUTTON será mostrar novamente o botão ADVPL e esconder-se.

Os limites

Bem, até aqui tudo é lindo, mas estes recursos possuem alguns limites específicos. Atualmente, uma classe ADVPL que herda uma classe do binário não pode ser herdada por outra classe ADVPL. Caso você tente por exemplo criar uma classe APBUTTON2 que herda APBUTTON, a mesma vai compilar, mas na hora de executar será gerado um erro de inicialização do construtor nos níveis superiores. Já a herança de classe ADVPL atualmente suporta apenas 2 níveis de herança. Por exemplo, classe FILHA FROM PAI, NETA FROM FILHA. Se você implementar a classe BISNETA e tentar herdar a classe NETA, ao executar por exemplo o construtor da BISNETA, onde haverá uma cascata de _Super para os construtores das camadas superiores, ( BISNETA -> NETA -> FILHA -> PAI ), a execução dos construtores entra em loop, finalizando o processo em execução com uma ocorrência de erro Advpl “stack depth overflow”.

As boas práticas

Inicialmente, além de procurar respeitar os limites estabelecidos, existem características de retenção de memória ligados ao uso de classes visuais e não-visuais no ADVPLe boas práticas gerais ligadas à orientação a objetos em geral, que devido ao nível de detalhamento e quantidade de tópicos, estes temas serão tratados nos próximos posts.

Conclusão

Estes tópicos servem como uma base, uma introdução ao assunto com alguns detalhes. O que vai fazer a diferença na utilização destes recursos é você pesquisar mais sobre o tema, e começar a usá-los no seu dia a dia, a experiência adquirida com alguns calos nos dedos e neurônios queimados usando estes recursos é que vai fazer a diferença. Na TDN, existe um guia completo das classes de interface visual e não-visual da linguagem Advpl, no link “http://tdn.totvs.com/pages/viewpage.action?pageId=6063177“. Para absorver este conteúdo, ler não é o bastante … é apenas o princípio !

Até o próximo post, pessoal 😉

Classes em Advpl – Parte 02

Continuando de onde paramos nas classes, vamos ver agora como criar duas classes em ADVPL, onde uma classe herdará a outra. Lembrando que ambas são casses cujo fonte é escrito em ADVPL e compilado no Repositório. Posteriormente vamos ver como codificar uma classe ADVPL herdando uma classe básica la linguagem ADVPL, implementada no TOTVS Application Server.

Mais um pouco de teoria

Quando criamos uma classe em Advpl herdando outra classe em Advpl, apenas especificamos na classe filha quem é a classe pai de onde herdamos todos os métodos e propriedades. Como não há escopo restrito para os métodos, todos os métodos são virtuais (isto é, podem ser re-implementados na classe filha).

E, é claro, de dentro de um método da classe filha, podemos chamar qualquer método das classes superiores. Em ADVPL não é permitido o recurso de herança múltipla ( onde uma classe filha pode herdar mais de uma classe pai simultâneamente).

Agora um pouco de código

Vamos implementar duas classes, uma classe pai e uma classe filha herdando a classe pai, e sobrescrevendo um de seus métodos. Vamos implementar um arroz com feijão e depois brincar um pouco com ela.

Partindo da premissa que você tenha acesso a um ambiente do ERP Microsiga Protheus, com um IDE / TDS para compilar código ADVPL, crie um novo fonte para testes, chamado APHELLO.PRW, acrescente-o ao seu projeto ( crie um novo apenas para testes), e entre com o código abaixo. Pode copiar e colar que funciona 😉

#INCLUDE "protheus.ch"
// Fonte de teste da classe com herança
User Function APTST2() 
Local oObj
oObj := APFILHA():New(123)
oObj:SayValue()
Return
// -----------------------------------------------------------
// Classe superior para demonstração de herança
CLASS APPAI
 DATA nValue as Integer
 METHOD New(nNum) CONSTRUCTOR
 METHOD SayValue()
ENDCLASS
// Construtor da classe pai, recebe um valor e guarda. 
METHOD New(nNum) CLASS APPAI
::nValue := nNum
Return self
// Mostra o valor guardado na tela, identificando na tela que 
// o método da classe Pai foi utilizado 
METHOD SayValue() CLASS APPAI
MsgInfo(::nValue,"Classe Pai")
Return
// -----------------------------------------------------------
// Classe Filha, herda a classe pai 
CLASS APFILHA FROM APPAI
 METHOD NEW(nNum) CONSTRUCTOR
 METHOD SayValue( lPai )
ENDCLASS
// Construtor da filha chama construtor da classe pai
METHOD NEW(nNum) CLASS APFILHA
_Super:New(nNum)
return self
// Metodo para mostrar o valor, pergunta ao operador se 
// deve ser chamado o metodo da classe pai ou não. 
METHOD SayValue() CLASS APFILHA
If MsgYesNo("Chamar a classe pai ?")
 _Super:SayValue()
Else
 MsgInfo(::nValue,"Classe Filha")
Endif
Return

Após compilar este fonte, você pode chamar a função U_APTST2 diretamente a partir do Smartclient, e deve ser apresentado na sua interface uma caixa de diálogo perguntando se você quer chamar o método da classe pai. Caso você responda sim, deve ser mostrada uma caixa de diálogo contendo o valor 123 guardado na propriedade nValue da classe pai, onde o título da janela é “Classe Pai”. Caso contrário, será mostrada uma caixa de diálogo com o mesmo valor, onde a propriedade nValue da classe pai foi acessada de dentro do método da classe filha — repare no título diferenciado das caixas de diálogo das duas implementações. Agora vamos olhar com uma lupa.

Na declaração da classe APFILHA, após o nome da classe usarmos a instrução FROM, seguido do nome da classe pai, chamada APPAI. Dada a natureza dinâmica das classes Advpl, a classe APPAI usada na herança pode estar em outro fonte / arquivo.

Para chamar um método da classe superior, usamos a palavra reservada “_Super”. Ela deve ser usada apenas dentro da implementação (corpo) de um método, e deve ser escrita exatamente assim, com as letras maiúsculas e minúsculas desta forma (esta palavra reservada é case-sensitive), e somente pode ser usada para referenciar um método do nível superior (classe pai) da herança.

No caso da herança ADVPL, a classe filha não precisa chamar explicitamente o construtor da classe pai, mas isto é uma boa prática de desenvolvimento na orientação a objetos. Como a herança das classes ADVPL permite você herdar uma classe que herda de outra classe (CLASS APNETA FROM APFILHA), caso a classe APPAI possua um método que não foi reimplementado na classe APFILHA , mas a classe APNETA quer utilizá-lo, basta esta referenciar o método usando _Super. A busca nos níveis superiores da herança é recursiva e automática para métodos e propriedades.

Onde foi parar o self ?

No exemplo de classes do post anterior, dentro da implementação dos métodos, para referenciar uma propriedade da minha instância, foi usada a variável “self”, e no exemplo atual usamos “::”. A única diferença entre eles é a grafia. A sequencia de dois caracteres dois-pontos juntos “::” é um #translate de compilação, que é traduzido para “self:”. Utilizar o “::” ao invés de “self:” é a convenção de grafia mais usual.

Conclusão

A cada passo da orientação a objeto vamos estudar um pouco mais de como ela funciona, bem como as melhores formas de tirar proveito dessa tecnologia! No próximo post sobre Classes em ADVPL vamos ver as diferenças para codificar uma classe ADVPL que herda diretamente de uma classe de objeto de interface visual da linguagem!

Até o próximo post, pessoal 😉