Classe ZDBFTABLE – Índice em Memória

Introdução

Nos posts anteriores, começamos a ver a implementação da classe ZDBFTABLE, uma forma de leitura de arquivos no formato DBF, sem o uso de Driver ou RDD, lendo o arquivo direto no disco usando as funções de baixo nível de arquivo do AdvPL. Agora, vamos ver como criar um índice eficiente em memória

Classe ZDBFMEMINDEX

Criar um índice para um arquivo DBF é uma forma não apenas de permitir uma navegação ordenada nos registros, mas também uma forma de realizar uma busca muito rápida pelo índice. Como a ideia original da classe ZDBFTABLE é realizar leitura de dados de um DBF, seria deveras interessante ter uma forma de criar um ou mais índices para a tabela.

Devido a natureza das tabelas DBF, um índice com chave simples ou composta (um ou mais campos) pode usar qualquer expressão ou função do AdvPL, onde o resultado da expressão é gravado em um índice no disco. A implementação da classe de índice em memória implementa esta funcionalidade, mas sem persistir o índice em disco. Ele é criado e mantido na memória por um array ordenado.

CLASS ZDBFMEMINDEX

   DATA oDBF		// Objeto ZDBFTABLE relacionado ao índice 
   DATA cIndexExpr      // Expressão AdvPL original do índice
   DATA bIndexBlock     // CodeBlock para montar uma linha de dados do índice
   DATA aIndexData      // Array com os dados do índice ordenado pela chave 
   DATA aRecnoData      // Array com os dados do índice ordenado pelo RECNO 
   DATA nCurrentRow     // Numero da linha atual do índice 
   DATA lSetResync      // Flag de resincronismo pendente da posição do índice
   DATA lVerbose

   METHOD NEW(oDBF)     // Cria o objeto do índice
   METHOD CREATEINDEX(cIndexExpr) // Cria o índice baseado na chave fornecida 
   METHOD CLOSE()       // Fecha o índice e limpa os dados da memória 

   METHOD GetFirstRec() // Retorna o RECNO do primeiro registro do índice
   METHOD GetPrevRec()  // Retorna o RECNO do Registro anterior do índice
   METHOD GetNextRec()  // Retorna o RECNO do próximo registro do índice
   METHOD GetLastRec()  // Retorna o RECNO do último registro do índice 
   
   METHOD GetIndexExpr()  // Rertorna a expressão de indexação 
   METHOD GetIndexValue() // Retorna o valor da chave de indice do registro atual 
   METHOD GetIndexRecno() // REtorna o numero do RECNO da posição do índice atual 
   METHOD IndexSeek()     // Realiza uma busca ordenada por um valor informado 
   METHOD RecordSeek()    // REaliza uma busca no indice pelo RECNO 
   METHOD UpdateKey()     // Atualiza uma chave de indice ( em implementação ) 
   
   METHOD _BuildIndexBlock(cIndexExpr) // Cria o codeblock da chave de indice 
   METHOD _CheckSync()    // Verifica a necessidade de sincronizar o indice 
   METHOD SetResync()     // Seta flag de resincronismo pendente
   METHOD SetVerbose()    // Seta modo verbose com echo em console ( em implementação 
   
ENDCLASS

Trocando em miúdos

Quando navegamos pela ordem física de registros de uma tabela DBF — ou seja, pelo número do RECNO — basicamente somamos uma unidade no marcador de registro para acessar o próximo, e subtraímos uma unidade para acessar o registro anterior, o primeiro registro da tabela é o número um, e o último registro é o maior registro da tabela (LastRec).

Quando optamos por realizar a navegação por um índice, basicamente criamos uma lista ordenada do tipo chave-valor, onde cada registro gera uma chave baseado na expressão de indexação, e o índice é responsável por guardar a chave e o número do RECNO correspondente desta chave. Uma vez que a lista seja ordenada, cada chave aponta para um registro físico (RECNO).

Logo, ao navegar usando um índice, eu preciso ter um marcador de controle (::nCurrentRow) para informar em qual linha do índice eu estou posicionado, e quando a tabela receber uma instrução de SKIP(), para ir para o próximo registro, se eu estou usando um índice, eu pergunto para o índice qual é o número do próximo registro que eu preciso posicionar.

Método CreateIndex()

METHOD CREATEINDEX( cIndexExpr ) CLASS ZDBFMEMINDEX

// Guarda a expressão original do indice
::cIndexExpr := cIndexExpr

// Monta o CodeBlock para a montagem da linha de dados
// com a chave de indice
::_BuildIndexBlock( cIndexExpr )

// Agora varre a tabela montando o o set de dados para criar o índice
::aIndexData := {}
::aRecnoData := {}

// Coloca a tabela em ordem de regisrtros para a criação do indice
::oDBF:DbSetORder(0)
::oDBF:DBClearFilter()
::oDBF:DbGoTop()

While !::oDBF:Eof()
	// Array de dados 
	// [1] Chave do indice
	// [2] RECNO
	// [3] Numero do elemento do array aIndexData que contém este RECNO
	aadd( ::aIndexData , { Eval( ::bIndexBlock , ::oDBF ) , ::oDBF:Recno() , NIL } )
	::oDBF:DbSkip()
Enddo

// Sorteia pela chave de indice, usando o RECNO como criterio de desempate
// Duas chaves iguais, prevalesce a ordem fisica ( o menor recno vem primeiro )
aSort( ::aIndexData ,,, { |x,y| ( x[1] < y[1] ) .OR. ( x[1] == y[1] .AND. x[2] < y[2] ) } )

// Guardando a posicao do array ordenado pelos dados na terceira coluna do array 
aEval( ::aIndexData , {| x,y| x[3] := y })

// Agora, eu preciso tambem de um indice ordenado por RECNO 
// Porem fazendo referencia a todos os elementos do array, mudandi apenas a ordenação 

// Para fazer esta magica, cria um novo array, referenciando 
// todos os elementos do array principal , então ordena
// este array pelo RECNO
::aRecnoData := Array(len(::aIndexData))
aEval(::aIndexData , {|x,y| ::aRecnoData[y] := x })

// Ordena o array aRecnoData em ordem crescente de RECNO
aSort( ::aRecnoData ,,, { |x,y| x[2] < y[2] } )

Return .T.

Aqui é que a mágica acontece. Neste fonte eu uso e abuso de Arrays, aEval e ASort. Primeiro, eu preciso criar um array que tenha pelo menos o valor da expressão de ordenação de cada registro, e o número do registro correspondente. Estes dados serão armazenados no array ::aIndexData. Por razões que eu vou explicar mais abaixo, este array possui uma coluna adicional, que contém qual é o número deste elemento no próprio array — parece não fazer sentido, mas vai fazer.

Primeiro, a expressão AdvPL recebida para criar o índice pode retornar uma String, um número ou uma data. Podemos criar uma chave composta usando dois campos por exemplo, mas como a expressão final do valor chave a ser ordenado é única, a expressão de índice normalmente concatena estes campos — sendo eles do tipo  “C” Caractere, por exemplo. Se existem campos de tipos diferentes a serem usados para gerar um índice, normalmente convertemos tudo para string: Campos numéricos são convertidos para Caractere usando a função STR(), passando como parâmetro o valor do campo, o tamanho do campo e a quantidade de decimais. Para campos data, convertemos para string usando DTOS() — que converte a data no formado AAAAMMDD (ou YYYYMMDD), própria para ordenação em string.

::_BuildIndexBlock( cIndexExpr )

Uma vez montado o CodeBlock para gerar um valor de chave de ordenação por registro, usamos o objeto  oDBF para limpar qualquer filtro da tabela, usar a ordem física dos registros, posicionar no primeiro, e criar o array por enquanto apenas com o valor de cada chave, e o RECNO correspondente — primeira e segunda colunas do Array — varrendo a tabela do primeiro ao último registro.

While !::oDBF:Eof()
	// Array de dados 
	// [1] Chave do indice
	// [2] RECNO
	// [3] Numero do elemento do array aIndexData que contém este RECNO
	aadd( ::aIndexData , { Eval( ::bIndexBlock , ::oDBF ) , ::oDBF:Recno() , NIL } )
	::oDBF:DbSkip()
Enddo

Feito isso, a ordenação deste array deve levar em conta que, caso hajam expressões de índice de mesmo valor, o campo RECNO passa a ser um fator de ordenação. Chaves repetidas do índice são ordenadas pelo valor do RECNO, no menor para o maior.

// Sorteia pela chave de indice, usando o RECNO como criterio de desempate
// Duas chaves iguais, prevalesce a ordem fisica ( o menor recno vem primeiro )
aSort( ::aIndexData ,,, { |x,y| ( x[1] < y[1] ) .OR. ( x[1] == y[1] .AND. x[2] < y[2] ) } )

Agora que o array ::aIndexData está ordenado, vamos preencher a terceira coluna com a posição de cada elemento no array ordenado. Para isso,  preenchemos a terceira coluna deste Array usando:

// Guardando a posicao do array ordenado pelos dados na terceira coluna do array 
aEval( ::aIndexData , {| x,y| x[3] := y })

A função AEVAL() passa dois parâmetros para o Codeblock, o primeiro é o elemento do Array em processamento, e o segundo parâmetro é o número da posição deste elemento no Array. Deste modo, eu uso esta AEval() para atribuir o número da própria posição neste array.

O pulo do gato vêm agora. Embora eu possa estar usando um índice para navegar na tabela,  uma vez que faça um “Goto” em um determinado registro, eu preciso posicionar nele. E ao fazer isso, eu preciso pesquisar no array de índice qual é a posição atual do índice para o registro que eu posicionei. Afinal, uma vez posicionado em um registro pelo seu número, ao perguntar qual é o próximo registro desta ordem para o índice, como ele vai saber onde ele está ?!

::aRecnoData := Array(len(::aIndexData))
aEval( ::aIndexData , {|x,y| ::aRecnoData[y] := x })
aSort( ::aRecnoData ,,, { |x,y| x[2] < y[2] } )

Para isso, o array chamado de ::aRecnoData, foi criado. Ele serve para referenciar todos os elementos do primeiro array, porém ordenando os elementos pelo RECNO. Deste modo eu não duplico os dados na memória, apenas faço referência aos elementos do primeiro array, em outra ordenação.

Assim, quando eu faço um posicionamento direto na tabela usando Goto() — sem usar o índice — eu ligo um flag de re-sincronismo pendente, e quando eu voltar a navegar pelo índice, caso exista um re-sincronismo pendente, eu uso o array ordenado pelo RECNO para realizar uma busca binária, para localizar qual é a linha do array ordenado pela chave de índice (::aIndexData) que corresponde ao RECNO atualmente posicionado na tabela — e justamente esta informação está na terceira coluna dos elementos de ambos os arrays.  Ao recuperar a posição do índice atual, eu consigo ir para o anterior ou próximo elementos na ordem do índice.

Método interno _BuildIndexBlock

De modo similar — praticamente uma cópia — ao método de filtro de tabela, o método que cria o Codeblock para a geração do valor chave de ordenação a partir da expressão AdvPL informada, espera que qualquer campo da tabela referenciado no índice esteja em letras maiúsculas. Desse modo ele cria um Codeblock de ordenação que recebe o objeto da tabela em si, e retorna o valor da chave de ordenação baseado na expressão informada usando o conteúdo dos campos do registro atualmente posicionado.

METHOD _BuildIndexBlock(cIndexExpr) CLASS ZDBFMEMINDEX
Local aCampos := {}
Local cTemp
Local nI, nPos

// Cria lista de campos
aEval( ::oDBF:aStruct , {|x| aadd(aCampos , x[1]) } )

// Ordena pelos maiores campos primeiro
aSort( aCampos ,,, {|x,y| alltrim(len(x)) > alltrim(len(y)) } )

// Copia a expressao de índice
cTemp := cIndexExpr

// Troca os campos por o:Fieldget(nCpo)
// Exemplo : CAMPO1 + CAMPO2 será trocado para o:FieldGet(1) + o:FieldGet(2)

For nI := 1 to len(aCampos)
	cCampo := alltrim(aCampos[nI])
	nPos   := ::oDBF:Fieldpos(cCampo)
	cTemp  := StrTran( cTemp , cCampo,"o:FieldGet(" +cValToChar(nPos)+ ")")
Next

// Monta a string com o codeblock para indice
cTemp := "{|o| "+cTemp+"}"

// Monta efetivamente o codeblock de indice
::bIndexBlock := &(cTemp)

Return

Busca Binária – Métodos RecordSeek() e IndexSeek()

Uma busca binária somente pode ser realizada em cima de um array ordenado. A ideia e a implementação são simples: Você define um limite superior e inferior de busca, começando no primeiro e terminando no último elemento da lista, tira a média deste valor — calcula o “meio” entre estes dois pontos — e verifica se o valor procurado é igual, menor ou maior.

Se for igual, achou. Se for menor, redefine que o limite inferior para a busca é a posição do meio menos um , recalcula o meio novamente considerando os novos valores de topo e fim, e repete a busca. Caso o valor buscador for maior que o valor do meio da lista, redefine que o limite superior é o valor atual de meio mais um, recalcula o meio novamente considerando os novos valores de topo e fim, e repete a busca.

O desempenho desse tupo de busca é espantoso, pois a cada operação de comparação, metade da lista é desconsiderada. Deste modo, num pior cenário, em uma lista com 4 bilhões de registros, foram necessárias — no máximo — 32 comparações para encontrar um valor ou saber que ele não está lá. Vamos ver por exemplo o método para a busca no array ordenado pelo RECNO:

METHOD RecordSeek(nRecno) CLASS ZDBFMEMINDEX
Local lFound := .F. 
Local nTop := 1 
Local nBottom := Len(::aRecnoData)
Local nMiddle 

If nBottom > 0

	If nRecno < ::aRecnoData[nTop][2]
		// Chave de busca é menor que a primeira chave do indice
		Return 0
	Endif

	If nRecno > ::aRecnoData[nBottom][2]
		// Chave de busca é maior que a última chave
		Return 0
	Endif

	While nBottom >= nTop

		// Procura o meio dos dados ordenados
		nMiddle := Int( ( nTop + nBottom ) / 2 )

		If ::aIndexData[nMiddle][2] == nRecno
			// Achou 
			lFound := .T. 
			EXIT
		ElseIf nRecno < ::aRecnoData[nMiddle][2]
			// RECNO menor, desconsidera daqui pra baixo 
			nBottom := nMiddle-1
		ElseIf nRecno > ::aRecnoData[nMiddle][2]
			// RECNO maior, desconsidera daqui pra cima
			nTop := nMiddle+1
		Endif
	
	Enddo

	If lFound
		// Retorna a posição do array de dados 
		// ordenados (aIndexData) que contem este RECNO 
		Return ::aRecnoData[nMiddle][3]
	Endif
	
Endif

Return 0

O método IndexSeek() também usa o mesmo princípio, porém é feito em cima do array ordenado pela chave de índice (::aIndexData, coluna 1). Normalmente as buscas demoram menos de dois milésimos de segundo, em testes realizados com uma lista de 109 mil elementos. Também pudera, no máximo em 16 comparações este algoritmo localiza a informação. Se a informação procurada estiver fora do range de dados, em apenas uma ou duas comparações o algoritmo já determina que a informação com aquela chave não existe e retorna .F. para a operação de busca.

Observações

A classe de índice em memória não é usada diretamente, na verdade ela é usada internamente pelos métodos de criação de índice, ordenação e busca ordenada publicados na classe ZDBFTABLE. Através dela criamos, usamos e fechamos um ou mais índices.

Conclusão

Era uma prova de conceito de leitura, está virando quase um Driver completo. Já estou trabalhando na criação de tabelas e inclusão/alteração de dados, mas isso exige outros truques com os índices já criados, para permitir manutenção dos índices nestas operações. Assim que tiver mais novidades, sai mais um post.

Novamente agradeço a todos pela audiência, e lhes desejo TERABYTES de SUCESSO 😀

 

 

 

Classe ZDBFTABLE – Implementação de Filtro AdvPL

Introdução

Já que a classe ZDBFTABLE permite a navegação em uma tabela DBF, vamos ver como seria implementar um filtro ? E ver como ele funciona por dentro.

Filtros de dados em xBASE / Clipper

Quando se trabalha diretamente com o arquivo DBF diretamente, sem ter um SGDB ou um programa intermediário de gerenciamento, a implementação de um filtro é uma forma de criar uma expressão usando campos da tabela e operadores lógicos, que retorne .T. (Verdadeiro) caso o registro deva ser considerado nas operações de navegação da tabela e posicionamento de registros. Para isso são usados os comandos SET FILTER ou a função DBSetFilter().

A expressão de filtro em AdvPL informada é traduzida para um Codeblock, que passa a ser executado quando você por exemplo faz um DBSkip(). Ao ler o próximo registro a ser posicionado, caso exista uma condição de filtro especificada, internamente o driver executa o Codeblock, e caso o mesmo retorne .F., o driver avança mais um registro e repete a operação até encontrar o primeiro registro que atenda a condição de filtro ou a tabela chegue ao final (EOF).

Método DBSetFilter

METHOD DBSetFilter( cFilter ) CLASS ZDBFTABLE
Local aCampos := {}
Local cTemp
Local nI, nPos

// Cria lista de campos 
aEval( ::aStruct , {|x| aadd(aCampos , x[1]) } )

// Ordena pelos maiores campos primeiro 
aSort( aCampos ,,, {|x,y| alltrim(len(x)) > alltrim(len(y)) } )

// Copia a expressao filtro
cTemp := cFilter

// Troca os campos por o:Fieldget(nCpo)
// Exemplo : CAMPO > 123 será trocado para o:FieldGet(1) > 123

For nI := 1 to len(aCampos)
	cCampo := alltrim(aCampos[nI])
	nPos := ::Fieldpos(cCampo)
	cTemp := Strtran( cTemp , cCampo,"o:FieldGet(" +cValToChar(nPos)+ ")")
Next

// Monta a string com o codeblock para filtro 
cTemp := "{|o| "+cTemp+"}"

// Monta efetivamente o codeblock 
::bFilter := &(cTemp)

Return

A implementação foi feita de forma similar ao comportamento original do DBF com Clipper ou mesmo com AdvPL. Porém, como eu não tenho um parser léxico para destrinchar a expressão de filtro, eu fiz da forma mais simples: Primeiro, qualquer campo da tabela atual usado na expressão de filtro deve ser escrito em letras maiúsculas.

Então, eu crio a lista de campos da tabela baseado na estrutura, ordeno a lista pelos campos com o maior nome, para depois trocar cada ocorrência de campo por uma chamada do método Fieldget() do campo, já passando o número do campo da estrutura como parâmetro. Os campos tem que ser ordenados pelo maior nome primeiro, pois eu posso ter por exemplo dois campos com o mesmo começo no nome : XIS e XIS2. Eu devo começar a troca sempre pelos campos de maior nome.

E, finalmente, eu crio um Codeblock com a expressão resultante, recebendo em “o” a instância do objeto da tabela, e nos métodos de navegação — DbSkip(), DBGoTop() e DBGoBottom() — eu passo a verificar se o registro deve ser considerado ou não, fazendo um Eval() do filtro informando o “self” — minha própria instância — como parâmetro.

Por exemplo, imagine que eu sete a condição de filtro “!Empty(X3_CBOX)”, vamos ver como ficaria o Codeblock resultante:

cFilter --> "!Empty(X3_CBOX)"
cTemp   --> "{|o| !Empty(o:FieldGet(28))}"

Método DBSkip()

METHOD DbSkip( nQtd ) CLASS ZDBFTABLE 
Local lForward := .T. 

If nQtd  == NIL
	nQtd := 1
ElseIF nQtd < 0  	lForward := .F.  Endif // Quantidade de registros para mover o ponteiro // Se for negativa, remove o sinal  nQtd := abs(nQtd) While nQtd > 0 
	If lForward
		IF ::_SkipNext()
			nQtd--
		Else
			// Bateu EOF()
			::_ClearRecord()
			Return
		Endif
	Else
		IF ::_SkipPrev()
			nQtd--
		Else
			// Bateu BOF()
			Return
		Endif
	Endif
Enddo

// Traz o registro atual para a memória
::_ReadRecord()

Return

O método DBSkip em si ficou simples. Ele recebe como parâmetro o número de registros que devem ser movimentados. Porém, em caso de filtro, eu preciso contar que as movimentações foram feitas apenas com registros válidos. Desse modo, quem faz o controle de navegação e filtro são os métodos internos _SkipNext e _SkipPrev.

Método interno _SkipNext

METHOD _SkipNext() CLASS ZDBFTABLE
Local nNextRecno

While (!::lEOF)

	// Parte do registro atual , soma 1 
	nNextRecno := ::Recno() + 1 

	// Passou do final de arquivo, esquece
	If nNextRecno > ::nLastRec
		::lEOF := .T.
		::_ClearRecord()
		Return .F. 
	Endif

	// ----------------------------------------
	// Atualiza o numero do registro atual 
	::nRecno := nNextRecno

	// Traz o registro atual para a memória
	::_ReadRecord()

	// Passou na checagem de filtro ? Tudo certo 
	// Senao , continua lendo ate achar um registro valido 
	If ::_CheckFilter()
		Return .T. 
	Endif

Enddo

Return .F.

Como a navegação (por enquanto) não usa índice, o próximo registro sempre será o atual mais um. Então, a função incrementa o registro, verifica se não atingiu EOF, lê o registro para a memória, e então verifica se o registro não está filtrado, usando o método interno _CheckFilter(). — Calma que a gente já chega nele .. é o próximo.

Método interno _CheckFilter

METHOD _CheckFilter() CLASS ZDBFTABLE
Local lOk := .T. 
If ::bFilter != NIL 
	lOk := Eval(::bFilter , self )	
Endif
Return lOk

O filtro setado foi guardado na propriedade ::bFilter. Caso ela não seja NIL, existe um filtro setado. Ao fazer o Eval() da condição de filtro, se o registro não atende a condição, o método _SkipNext() continua lendo os próximos registros até encontrar um registro válido.

Desempenho de filtro

Como a verificação de registro válido no filtro somente é realizada após o registro ser lido, durante o posicionamento. quando mais simples a expressão de filtro, mais rápida será a validação da visibilidade do registro. E, no momento de navegar pela tabela, quanto maior for a tabela, e quanto menos registros atenderem a condição de filtro, mais registros serão lidos na navegação para encontrar um registro válido.

Por exemplo, imagine uma tabela com 100 mil registros, onde você vai realizar um determinado processamento filtrado. Você seta o filtro, faz um DBGoTop() e um While !Eof() — DBSkip(). Mesmo que na sua tabela existam por exemplo apenas mil registros que atentam a condição de filtro, os 100 mil registros serão lidos e verificados se eles fazem parte do filtro ou não. Logo, cuidado com filtros e tabelas grandes.

Comportamento do filtro ISAM

Ao setar um filtro, o registro atualmente posicionado não é alterado, mesmo que ele não faça parte do filtro. Logo, normalmente reposicionamos a tabela no primeiro registro válido contemplando o filtro usando a função DBGoTop() — ou no nosso caso da classe ZDBFTABLE, o método DBGoTop().

Todas as funções de navegação ISAM ( DbGoTop(), DBGoBottom(), DBSkip() — e inclusive a DBSeek() — respeitam a condição de filtro. A única função que não respeita nada é a DBGoto(). Uma vez que eu posicione diretamente em um registro pelo seu número de RECNO, ele será lido e posicionado, mesmo que esteja deletado ou que não faça parte da seleção do filtro. Uma vez posicionado neste registro, um próximo DbSkip() vai posicionar no registro imediatamente posterior, considerando o filtro setado.

Para limpar o filtro, usamos o método DbClearFilter(), que também não mexe no posicionamento da tabela, apenas coloca NIL na propriedade onde têm o Clodeblock do filtro.

Conclusão

O fonte atualizado sempre está no GITHUB. Entre um post e outro sempre têm coisas novas. O uso é livre, fique a vontade !!!

Agradeço a todos novamente pela audiência, e lhes desejo TERABYTES DE SUCESSO 😀

 

Resolvendo o limite da função Randomize()

Introdução

No post Boas Práticas de Programação – Código Simples, Resultados Rápidos, eu mencionei um limite operacional da função Randomize() do AdvPL. Caso a diferença entre o maior e o menor número a ser sorteado for maior que 32767, a função vai sortear um número maior ou igual ao número inicial informado, e menor que o número inicial mais 32767.

Programa original

A chamada no fonte original era para sortear um número entre 100000 e 999999. Porém, devido a limitação operacional da função Randomize(), o maior resultado seria sempre menor que 132767.

nTmp := Randomize(100000,999999)

Para resolver esta limitação da função, podemos criar uma segunda função de sorteio, onde podemos tratar este limite de uma forma elegante e performática. Vamos criar a USER Function Randomic(). 

USER Function Randomic(nMin,nMax)
Local nDiff := nMax-nMin
Local nDec := 0
If nDiff < 32766
   Return Randomize(nMin,nMax)
Endif
While nDiff > 32765
   nDiff /= 10 
   nDec++
Enddo
nTmp := randomize(0,int(nDiff))
While nDec > 0 
   nTmp *= 10 
   nTmp += randomize(0,10) 
   nDec--
Enddo
Return nMin+nTmp

Como a U_Randomic() funciona

Inicialmente, determinamos usando a variável local nDiff qual é a diferença do maior para o menor número. Caso a diferença seja suportada pela função Randomize(), retornamos direto a chamada para a função Randomize(), passando os parâmetros originais.

Caso a diferença não seja contemplada pela função Randomize(), dividimos a diferença por 10 até que ela entre dentro do intervalo. Cada divisão realizada incrementa uma unidade na variável local nDec, que indica quantas casas da diferença original foram reduzidas. Uma vez que a diferença se enquadre nos valores suportados, chamamos a função Randomize(), para sortear um número entre 0 e o valor inteiro da diferença apurada após as divisões.

Sorteado este número, agora precisamos sortear mais alguns números para completar as casas decimais que foram “cortadas” da diferença original. A cada iteração, para quantas casas decimais foram cortadas — valor guardado na variável nDec — o valor anteriormente sorteado é multiplicado por 10, e um novo valor sorteado entre 0 e 9 é adicionado ao resultado, decrementando uma unidade em nDec. Terminado o processo, o número final sorteado será o número inicial somando com o número  final sorteado, armazenado em nTmp.

Exemplo

Vamos rodar o programa de testes abaixo, chamando uma vez a função U_RANDOMIC() usando o IDE/TDS em modo de depuração.

User Function TstRand()
Local nRand
nRand := U_Randomic(100000,1000000)
conout(nRand)
Return

Ao entrarmos na função U_Randomic(), a diferença entre o numero final e o inicial será de 900000 (novecentos mil). Ao passar pelo primeiro loop, a primeira divisão por 10 faz o número baixar para 90000 (noventa mil), e nDec é incrementado para uma unidade. Como o número ainda é maior que 32765, este loop é executado novamente, onde nDiff baixa agora para 9000 (nove mil) e nDec é incrementado para 2. Como agora nDiff é menor que 32765, o programa continua.

O sorteio do novo número, a ser armazenado na variável nTmp, será feito usando a função Randomize(), informando o valor mínimo 0 e o máximo 9000. Durante a depuração, o número sorteado por exemplo foi 1271.

Agora, como houve a redução de duas casas decimais, o próximo loop será executado duas vezes. Na primeira execução, o número nTmp é multiplicado por 10 — resultando em 12710 — e um novo dígito entre 0 e 9 será sorteado e acrescentado em nTmp. foi sorteado o número 7, e acrescentado em nTmp, fazendo seu valor atual ser 12717. Na segunda execução, este valor foi multiplicado novamente por 10 — resultando em 127170 — e um novo número foi sorteado e acrescentado — foi sorteado o número 4, e nTmp passou a conter o valor 127174.  Nas duas execuções, nDec foi decrementado duas vezes, voltando a ser 0 (zero). Pronto, na ultima linha, acrescentamos o número inicial (100000) ao número sorteado (127174), resultando no número 227174.

Da forma que a função foi escrita, ela torna muito rápido e seguro o processo de sorteio, não havendo chance do valor sorteado ser maior que o especificado como parâmetro para a função.

Operadores especiais utilizados

Quando queremos realizar uma operação aritmética com uma variável, e queremos atualizar esta mesma variável com o valor resultante da operação, normalmente utilizamos uma sintaxe como:

variavel := variavel <operador> <operando>

Por exemplo:

nVar := nVar * 10 
nVar := nVar + 10 
nVar := nVar + 1

Em AdvPL, existem operadores compostos  especiais, que ao mesmo tempo fazem a atribuição e a operação aritmética. Por exemplo, as operações acima podem ser escritas da seguinte forma:

nVar *= 10
nVar += 10 
nVar++

Os operadores +=-=*=  e  /= são binários — exigem dois argumentos, a variável do lado esquerdo que será usada como base para a operação e receberá o resultado, e a expressão do lado direito (variável ou constante), que será utilizada para realizar a operação. Respectivamente são os operadores de soma (+), subtração (-), multiplicação (*) e divisão (/). Já os operadores ++ e — são unários — têm apenas um argumento, que é a variável em questão, e respectivamente somam ou subtraem o valor 1 da variável informada.

Conclusão

Mesmo que alguma função básica da linguagem AdvPL possua alguma restrição operacional, o conhecimento das demais funcionalidades e capacidades da linguagem podem tornar fácil uma implementação de um novo recurso que atenda a sua necessidade.

Agradeço novamente a audiência, e desejo a todos TERABYTES DE SUCESSO !!! 😀

Referências

 

 

Algoritmos – Parte 02 – Permutações

Introdução

No post anterior (Algoritmos – Parte 01 – Loterias), vimos a criação de um algoritmo para realizar combinações simples, que pode ser usado na maioria das loterias numéricas. Agora, vamos ver um algoritmo de permutação — Algoritmo de Heap — e ver como fazer a portabilidade de um pseudo-código para AdvPL.

Algoritmo de Heap

O Algoritmo de Heap é até hoje a forma mais optimizada de gerar todas as possibilidades de permutações em um conjunto de elementos. A permutação é um processo pelo qual podemos criar sequências não repedidas dos elementos de um conjunto, alterando a sua ordem. Por exemplo, partindo de um conjunto de três números (1, 2 e 3), podemos criar as seguintes permutações:

1 2 3 
1 3 2 
2 1 3
2 3 1 
3 1 2
3 2 1

Calcula-se o número total de possibilidades de permutação de um conjunto com a fórmula P(m) = m! –> Onde P é o número de possibilidades de permutação e m é o número de elementos do conjunto, e  “!” é o símbolo da operação fatorial. Por exemplo, em um conjunto de 3 elementos, temos 3! ( 3! = 3*2 = 6) conjuntos ordenados resultantes.

Pseudocódigo

A partir da Wikipedia, por exemplo, podemos obter o pseudocódigo do algoritmo — uma representação em linguagem quase natural da sequência de operações nos conjuntos de dados para se chegar ao resultado. Esta versão do pseudo-código é a não-recursiva.

procedure generate(n : integer, A : array of any):
    c : array of int

    for i := 0; i < n; i += 1 do
        c[i] := 0
    end for

    output(A)

    i := 0;
    while i < n do
        if  c[i] < i then
            if i is even then
                swap(A[0], A[i])
            else
                swap(A[c[i]], A[i])
            end if
            output(A)
            c[i] += 1
            i := 0
        else
            c[i] := 0
            i += 1
        end if
    end while

Agora, vamos converter isso para AdvPL, primeiro de uma forma bem simples, depois de uma forma mais elaborada. Inicialmente, vamos fazer uma tradução “crua” para o AdvPL, porém funcional.

STATIC Function Generate( n , A )
Local c := {} , i
For i := 1 to n
  aadd(c,0)
Next
output(A)
i := 0 
While i < n
  If  c[i+1] < i
    if ( i % 2 ) == 0 
      swap(A, 1 , i+1)
    else
      swap(A, c[i+1]+1, i+1)
    end if
    output(A)
    c[i+1]++
    i := 0
  Else
    c[i+1] := 0
    i++
  EndIf
Enddo


STATIC Function swap(aData,nPos1,nPos2)
Local nTemp := aData[nPos1]
aData[nPos1] := aData[nPos2] 
aData[nPos2] := nTemp
Return

STATIC Function output(A)
Local i, R := ''
For i := 1 to len(A)
  If !empty(R)
    R += ', '
  Endif
  R += cValToChaR(A[i])
Next
conout(R)
Return

Diferenças na Implementação

A primeira diferença nós vemos logo de início ao usar os Arrays em AdvPL. O pseudo-código parte da premissa que um Array de N posições é endereçado de 0 a N-1 — Isto é, o primeiro elemento do Array é o elemento 0 (zero.) Já em AdvPL, o primeiro elemento do array é 1 (um). Logo, nós mantemos toda a lógica do programa inicial, inclusive as variáveis como se o array fosse base 0 (zero), porém na hora de endereçar os elementos do array, somamos uma unidade. Logo:

if c[i] < i

foi transformado para

if c[i+1] < i

A função swap() tem como objetivo trocar os elementos do array, um pelo outro. Como em AdvPL os arrays são passados por referência, podemos implementar a função de troca guardando o valor do elemento informado em uma variável local, depois atribuímos o conteúdo do segundo elemento informado sobre o primeiro, e então atribuímos o conteúdo salvo do primeiro elemento no segundo — vide função swap(). O diferencial dela em relação ao pseudocódigo é que eu passo para ela em AdvPL três parâmetros: O Array, e as duas posições a serem trocadas.

No pseudo-código, para verificar se um determinado numero é par (even em inglês), pode ser em AdvPL verificando  se o resto da divisão por dois é zero. Para isso, poderíamos usar a função mod(), ou de forma mais prática, o operador “%”.

if ( i % 2 ) == 0

Outro ponto de atenção é justamente a chamada da função swap() quando o número não for par. Veja no pseudocódigo:

swap(A[c[i]], A[i])

Agora, em AdvPL, a implementação ficou assim:

swap(A, c[i+1]+1, i+1)

Reparem que o array c[] guarda uma posição de um array. Como estamos trabalhando com array em base 1, eu devo somar 1 para recuperar o elemento do array c, e como o seu resultado será usado para indicar uma posição do array A[], eu também preciso somar 1.

Já a função output(), cujo entendimento óbvio é mostrar um dos conjuntos obtidos na permutação, implementamos simplesmente recebendo o Array , e criando uma string com o conteúdo de seus elementos separados por vírgula. Para testar o fonte acima, vamos usar a seguinte função:

User Function Permuta()
Generate( 4 , {'A' ,'B' ,'C' ,'D' } )
Return

Após salvarem, compilarem e executarem o programa acima, o resultado no log de console do Protheus Server deve ser:

A, B, C, D
B, A, C, D
C, A, B, D
A, C, B, D
B, C, A, D
C, B, A, D
D, B, A, C
B, D, A, C
A, D, B, C
D, A, B, C
B, A, D, C
A, B, D, C
A, C, D, B
C, A, D, B
D, A, C, B
A, D, C, B
C, D, A, B
D, C, A, B
D, C, B, A
C, D, B, A
B, D, C, A
D, B, C, A
C, B, D, A
B, C, D, A

Conclusão

Vendo o fonte assim, prontinho, parece fácil. Porém, eu comecei resolvendo trocar o nome das variáveis da implementação em AdvPL ao transcrever o pseudocódigo, e o programa não gerava os números corretamente. Joguei fora a primeira versão e parti do código original, mantendo o nome das variáveis, então funcionou.

Novamente agradeço a todos pela audiência e desejo a todos TERABYTES DE SUCESSO !!! 

Referências

Algoritmos – Parte 01 – Loterias

Introdução

Nos primeiros posts no Blog sobre programação — vide Desmistificando a análise de sistemas e Desmistificando a programação — foi colocada de forma simples a ideia de programar alguma coisa, como sendo apenas uma sequência de instruções e decisões para se realizar uma tarefa. E, realmente é simples assim, o que precisamos fazer é usar corretamente a gramática da linguagem para realizar as tarefas em pequenas etapas, criando tarefas maiores e reaproveitando tarefas menores.

Algoritmos

Uma sequência de instruções para realizar uma tarefa específica pode ser chamada de “Algoritmo” — verifique a definição na Wikipedia – Algoritmo. Não é algo aplicado apenas a programação de computadores.

Consultando também a Wikipédia – Lista de Algoritmos, podemos ver vários exemplos de problemas específicos resolvidos com sequências de operação. Como o algoritmo em si trata apenas da sequência de operações para obter um resultado, ele pode ser implementado em várias linguagens de programação.

Alguns dos mais conhecidos e utilizados são algoritmos de ordenação e busca de dados, compressão, sorteio de números (números randômicos), criptográficos (segurança da informação), entre outros. Na internet podemos obter não apenas vários modelos de algoritmos, mas também várias implementações dos mesmos em várias linguagens de programação.

Algoritmos em AdvPL

Vamos pegar um problema qualquer, e criar um algoritmo para resolvê-lo, um por tópico. Um problema bem interessante de ser resolvido usando um programa de computador, é por exemplo lidar com análise combinatória. Podemos usar um algoritmo de geração de combinações (ou Combinação Simples) para, por exemplo, criar massas de dados explorando as combinações de vários parâmetros para testes de funções, combinar números para cartões de loteria — adoro esse algoritmo — entre outras finalidades. Vamos ver como realizar uma análise combinatória eficiente para loterias em AdvPL.

Combinação para Loterias

Em um determinado cartão de loteria, podemos preencher no mínimo N números diferentes, dentre um total de X números disponíveis, para concorrer a um prêmio caso uma quantidade mínima de números sorteados estejam presentes entre os N números do cartão.

Quando queremos por exemplo, determinar todas as possibilidades de combinação de Y números em cartões de X números, utilizamos um recurso de análise combinatória chamado “Combinação Simples”. Atualmente, para alguns tipos de loterias,o próprio bilhete de apostas já permitem você fazer uma aposta com mais números do que a aposta mínima. Neste caso, a sua aposta equivale a todas as possibilidades de combinação simples dos Y números em um cartão de X números.

MEGA-SENA

Vamos tomar como exemplo a MEGA-SENA, onde a aposta mínima é um bilhete com seis números preenchidos, a um valor de R$ 3,50 . Podemos preencher de 6 a 15 números em um cartão ou bilhete, porém o preço da aposta sobe proporcionalmente ao número de combinações simples da quantidade de números preenchidos em blocos de seis números. Veja a tabela abaixo, de apostas e preços, e a quantidade de apostas de 6 números equivalente.

NUMEROS NO  | VALOR DA     | EQUIVALE A <n> 
BILHETE     | APOSTA       | APOSTAS de 6 números
------------+--------------+------------------------          
6 números   | R$ 3,50      |    1 aposta 
7 números   | R$ 24,50     |    7 apostas 
8 números   | R$ 98,00     |   28 apostas 
9 números   | R$ 294,00    |   84 apostas 
10 números  | R$ 735,00    |  210 apostas 
11 números  | R$ 1617,00   |  462 apostas 
12 números  | R$ 3234,00   |  924 apostas 
13 números  | R$ 6006,00   | 1716 apostas 
14 números  | R$ 10510,50  | 3003 apostas 
15 números  | R$ 17517,50  | 5005 apostas

Quantidade de combinações possíveis

A fórmula para determinar uma combinação simples C, de n números em conjuntos de k elementos é:

C(n,k) = n! / k! * (n-k)!

Onde “!” significa o valor FATORIAL do elemento, “*” é o operador de multiplicação, “/” é o operador de divisão.

Na matemática, o fatorial (AO 1945: factorial) de um número natural n, representado por n!, é o produto de todos os inteiros positivos menores ou iguais a n. A notação n! foi introduzida por Christian Kramp em 1808.

Vamos pegar por exemplo uma combinação de 12 elementos em conjuntos de 6 elementos — equivalente ao cartão de 12 números da MEGA-SENA.

C(12,6) = 12! / 6! * (12-6)!
C(12,6) = 12! / 6! * 6!
C(12,6) = 479001600 / 720 * 720 
C(12,6) = 479001600 / 518400 
C(12,6) = 924

Logo, antes mesmo de começar a fazer a combinação, podemos determinar o número de resultados possíveis.

Combinando elementos

A lógica para realizar a combinação dos elementos é basicamente a mesma, não importa a quantidade de elementos a combinar ou o tamanho do conjunto resultante. Porém, dependendo da forma que ela for implementada, ela tende a ficar mais pesada quanto maior a quantidade de elementos a combinar. Vamos pegar por exemplo a combinação de 7 elementos numéricos, de 1 a 7, em conjuntos de 6 elementos.

C(7,6) = 7! / 6! * (7-6)!
C(7,6) = 7! / 6! * (1)!
C(7,6) = 5040 / 720 * 1
C(7,6) = 7

Logo de antemão, sabemos que esta combinação resultará em 7 resultados. Agora, vamos fazer a combinação. Partindo dos números já ordenados, a primeira combinação é:

1 2 3 4 5 6

Para determinar o próximo resultado, pegamos o próximo numero do conjunto da última posição e incrementamos uma unidade:

1 2 3 4 5 7

Ao tentar fazer a mesma operação para pegar o terceiro resultado, o número 7 é o último elemento do conjunto. Então, precisamos incrementar o número na posição anterior — quinta posição. Quando fazemos isso, o número da posição que atingiu o limite deve ser o próximo elemento relativo a posição anterior. Logo, o próximo resultado será:

1 2 3 4 6 7

Repetindo novamente esta operação, começando da direita para a esquerda, na sexta posição, o elemento 7 já é o último do conjunto. Então vamos para a quinta posição. O próximo elemento desta posição seria o 7, porém ele é o último elemento da combinação, e eu não estou na última posição do conjunto de resultado, isto significa que ele já está em uso em uma posição posterior. Logo, vamos a posição anterior — quarta posição — e incrementamos o número 4 para 5, obtendo o resultado:

1 2 3 5 6 7

Repetindo os passos anteriores, os números 5, 6 e 7 não podem ser incrementados pois já são os elementos finais da combinação. Logo, incrementamos na terceira posição o 3 para 4, depois na segunda posição de 2 para 3, depois na primeira, de 1 para 2, e depois acabou, pois não há como incrementar mais nada.

1 2 4 5 6 7 
1 3 4 5 6 7 
2 3 4 5 6 7

Com isso obtivemos os 7 resultados possíveis. Agora, vamos colocar essa regra em um código fonte. Para facilitar o uso deste recurso, vamos criá-lo como uma Classe em AdvPL. Após construir e otimizar o algoritmo, a primeira versão ficou assim (fonte ACOMB.PRW):

#include "protheus.ch"

CLASS ACOMB FROM LONGNAMECLASS

  DATA nCols
  DATA aElements
  DATA nSize
  DATA aControl
  DATA aMaxVal
  DATA nPos

  METHOD NEW()
  METHOD GETCOMB()
  METHOD NEXTCOMB()
  METHOD GETTOTAL() 

ENDCLASS

METHOD NEW( nCols , aElements ) CLASS ACOMB
Local nI , nMax
::nCols := nCols
::aElements := aElements
::nSize := len(aElements)
::nPos := nCols
::aControl := {}
::aMaxVal := {}
nMax := ::nSize - ::nCols + 1
For nI := 1 to ::nCols
  aadd(::aControl,nI)
  aadd(::aMaxVal, nMax )
  nMax++
Next
Return self

METHOD GETCOMB() CLASS ACOMB
Local nI , aRet := array(::nCols)
For nI := 1 to ::nCols
  aRet[nI] := ::aElements[ ::aControl[nI] ] 
Next 
Return aRet

METHOD NEXTCOMB() CLASS ACOMB
If ::aControl[::nPos] + 1 > ::aMaxVal[::nPos]
  ::nPos := ::nPos - 1 
  If ::nPos < 1 
    Return .F. 
  Endif
  If ::NEXTCOMB()
    ::nPos := ::nPos + 1
    ::aControl[::nPos] := ::aControl[::nPos-1]+1
  Else
    Return .F. 
  Endif
Else
  ::aControl[::nPos]++
Endif
Return .T.

METHOD GETTOTAL() CLASS ACOMB
Local nFat1 := Fatorial( ::nSize )
Local nFat2 := fatorial( ::nCols )
Local nFat3 := Fatorial( ::nSize - ::nCols )
Local nTot := nFat1 / ( nFat2 * nFat3 ) 
Return nTot

STATIC Function Fatorial(nNum)
Local nI := nNum - 1
While nI > 1 
  nNum *= nI 
  nI--
Enddo
Return nNum

A propriedade aControl controla os contadores de cada posição do conjunto de retorno, e a propriedade aMaxVal eu já determino qual é o valor máximo de um determinado contador para a coluna ou posição atual. O Método GetComb() retorna um array com os elementos combinados, e o método NextComb() determina qual a próxima combinação da sequência, atualizando o array aControl. Quando o método NextComb() retornar .F., não há mais combinações possíveis. E, usando o método GetTotal(), eu determino quantas combinações são possíveis.

Para testar a classe acima, vamos usar o seguinte fonte:

User Function ACombTst()
Local nI
Local nResult := 1
Local lEcho := .F. 
Local nTimer
Local nCols , aData := {}

// Monta 35 dezenas para combinar 
For nI := 1 to 35
  aadd(aData,strzero(nI,2))
Next
// Combinação em conjuntos de 6 dezenas 
nCols := 6
oLoto := ACOMB():New( nCols , aData )
nTotal := oLoto:GetTotal()
conout("Elementos ...... "+cValToChar(len(aData)) )
conout("Conjunto ....... "+cValToChar(nCols) )
conout("Combinacoes .... "+cValToChar(nTotal) )
If lEcho
  aRet := oLoto:GETCOMB()
  conout("("+strzero(nResult,6)+") "+aRet[1]+" "+aRet[2]+;
         " "+aRet[3] +" "+aRet[4]+" "+aRet[5]+" "+aRet[6] )
endif
nTimer := seconds()
While oLoto:NEXTCOMB()
  nResult++
  If lEcho
    aRet := oLoto:GETCOMB()
    conout("("+strzero(nResult,6)+") "+aRet[1]+" "+aRet[2]+;
           " "+aRet[3] +" "+aRet[4]+" "+aRet[5]+" "+aRet[6] )
  Endif
Enddo
nTimer := seconds() - nTimer
conout("Resultados ..... "+cValToChar(nResult) )
conout("Tempo .......... "+str(nTimer,12,3)+" s.")
Return

No meu notebook, determinar as 1623160 combinações possíveis de 35 números em blocos de 6 demorou aproximadamente 3,5 segundos. Vejamos o log de console:

Elementos ...... 35
Conjunto ....... 6
Combinacoes .... 1623160
Resultados ..... 1623160
Tempo .......... 3.531 s.

Sim, neste teste eu não peguei os resultados, e não imprimi os resultados, eu apenas chamei em loop o método NextComb() até ele calcular todas as combinações. Para a aplicação imprimir os resultados em console, basta colocar .T. na variável lEcho e recompilar o fonte. Não é necessário dizer que, haverá uma boa diferença de desempenho quando você passar a resgatar cada uma das combinações e mostrar/gravar cada uma no log de console.

Dividindo o número total de combinações pelo tempo que a aplicação demorou, a rotina gerou aproximadamente 459688 resultados por segundo. Eu diria que isso é um tempo fantasticamente rápido. O tempo necessário para gerar estas combinações é simplesmente irrelevante perto do tempo que você deve gastar para, por exemplo, registrar estas combinações em uma tabela ou Banco de Dados.

Outras Loterias

Vamos pegar agora a Lotofácil. Cada cartão tem 25 dezenas, a aposta mínima é um bilhete com 15 dezenas preenchidas, e o prêmio máximo é você acertar os 15 números. As chances de você ganhar jogando um bilhete com a aposta mínima é 1 em 3.268.760. Afinal, se você fizer todas as combinações de 25 dezenas em grupos de 15, é exatamente esse o número de combinações possível. Vamos ver isso rodando o programa ? Basta alterar o programa de teste para criar 25 dezenas, e atribuir 15 para nCols.

Elementos ...... 25
Conjunto ....... 15
Combinacoes .... 3268760
Resultados ..... 3268760
Tempo .......... 12.002 s.

Pode fazer a mesma coisa para a MEGA-SENA, são 60 elementos em conjunto de 6. Garanto que vai demorar bem mais que 12 segundos, afinal a MEGA-SENA são 50.063.860 possibilidades ou combinações, mais de 15 vezes do que a Loto Fácil. Vamos rodar, apenas pra ver quanto tempo demora.

Elementos ...... 60
Conjunto ....... 6
Combinacoes .... 50063860
Resultados ..... 50063860
Tempo .......... 94.201 s.

Conclusão

Mesmo sabendo de tudo isso, até agora eu não ganhei na loteria, pois matematicamente as chances de um número qualquer ser sorteado é uma para o conjunto de números. As chances de acertar todos os números de uma loteria com uma aposta é uma para o conjunto de possibilidades / combinações dos números que eu posso colocar no cartão. Matematicamente, as chances de qualquer aposta — qualquer uma, inclusive por exemplo as dezenas “01 02 03 04 05 06” , ou “05 10 15 20 25 30”, são as mesmas. A única forma de aumentar matematicamente a sua probabilidade ou chance de acerto é jogar mais cartões diferentes. E, no final das contas, você pode jogar um cartão com 16 números e não acertar nenhum.

Agradeço novamente a audiência, curtidas e compartilhamentos, e desejo a todos TERABYTES DE SUCESSO 😀

Referências

 

 

Protheus como Servidor de FTP

Introdução

Quando eu comentei um pouco sobre as capacidades do Servidor de Aplicação Protheus Server, em um post mais antigo, eu mencionei que ele não apenas servia a conexões do SmartClient para rodar aplicações AdvPL, mas também que ele poderia ser um servidor de HTTP, com páginas estáticas e dinâmicas — usando AdvPL ASP — bem como TELNET e FTP. No post de hoje, vamos explorar o que a gente puder sobre como usar um Protheus Server como servidor de FTP.

Configuração Mínima

Imagine que você quer usar um Protheus Server como um FTP Server, com acesso anônimo — sem criticar usuário e senha — e apenas disponibilizar uma estrutura de pastas para Download. Neste caso, a configuração mínima para este serviço, seria acrescentar no arquivo de configuração do Protheus (appserver.ini) a seção [FTP], com as seguinte chaves:

[ftp]
Enable=1
Port=21
Path=c:\Protheus12LG\EnvLight\ftp
CanAcceptAnonymous=1

Especificamos a porta padrão (21), o acesso anônimo habilitado, e o path raiz do FTP, a partir do qual as conexões terão acesso de Download. Dentro da pasta configurada em “path”, eu coloquei um arquivo chamado leiame.txt, vamos ver este acesso através de um cliente FTP nativo do Windows, usando o comando “ftp” em linha de comando.

C:\Users\siga0>ftp -A localhost
Connected to NOTE-JULIOW-SSD.
220 Connected to FTP server
331 Anonymous access allowed
502 Command not implemented
331 Anonymous access allowed, send email name as PASS
220 Logon successful
230 Welcome to Application Server FTP!
Anonymous login succeeded for siga0@NOTE-JULIOW-SSD
ftp> dir
250 PORT command successful
150 Opening ASCII mode data connection
-r-xr-x--- 1 owner group 39 Nov 04 20:10 leiame.txt
226 Transfer Complete
ftp: 74 bytes received in 0.00Seconds 37.00Kbytes/sec.
ftp> ls
250 PORT command successful
150 Opening ASCII mode data connection
leiame.txt
226 Transfer Complete
ftp: 15 bytes received in 0.00Seconds 15.00Kbytes/sec.
ftp>

Através do parâmetro “-A” na linha de comando, informamos ao cliente FTP que o Login deverá ser anônimo. Caso este parâmetro não seja especificado, você deve entrar manualmente com o usuário “anonymous“. Uma senha deve ser informada, mas não será validada — pode ser qualquer coisa, inclusive “anonymous”.

Após feito o login, executamos os comandos “ls” e “dir” para recuperar a lista de arquivos e pastas disponíveis para download. Vamos então fazer o download do arquivo “leiame.txt”:

ftp> get leiame.txt
250 PORT command successful
150 RETR command started
226 Transfer Complete
ftp: 39 bytes received in 0.00Seconds 39000.00Kbytes/sec.
ftp>

De dentro do FTP Client do Windows, podemos executar um comando do sistema operacional, prefixando ele com o sinal de exclamação. Por exemplo, para verificarmos  o conteúdo do arquivo na pasta local após o Download, vamos executar o comando “type”.

ftp> !type leiame.txt
Exemplo de Configuraτπo Mφnima de FTP
ftp>

No caso, o texto do arquivo justamente é “Exemplo de Configuração Mínima de FTP”. Porém, como a página de código do Prompt de Comando está com o CodePage 437 (CodePage original do IBM-PC, também conhecido por OEM-US, CP437 ou DOS Latin US), a acentuação é mostrada com outros caracteres. Para ver o arquivo da forma correta, ele pode ser aberto pelo NOTEPAD ou qualquer outro editor de textos, OU você deve digitar no Prompt de Comando a instrução abaixo, antes de abrir o cliente FTP:

mode con cp select=1252

Com isso, o seu Prompt de Comando vai usar o CodePage do Windows, CP1252, que também é o CodePage usado pelo Protheus. Para ver a lista de instruções implementadas na camada interna do FTP Server, use o comando remotehelp

ftp> remotehelp
214-The following commands are implemented
USER PASS ACCT QUIT PORT RETR
STOR DELE RNFR PWD CWD CDUP
MKD RMD NOOP TYPE MODE STRU
LIST HELP
214 HELP command successful
ftp>

Caso você tente fazer um upload no FTP nesta conexão, a operação será negada.

ftp> put upload.txt
250 PORT command successful
550 Access is denied
ftp>

Usando outros clientes FTP

Normalmente basta desligar o “Passive Mode” na configuração do programa que você usa como Cliente de FTP (SCP, WINSCP, etc.) que a conexão e operações são realizadas sem maiores problemas.

Implementando mais controles

Na configuração mínima, o FTP está totalmente aberto para download de qualquer arquivo colocado a partir da pasta configurada na chave PATH, para qualquer cliente que conecte usando a identificação “anonymous” — ou seja, sem autenticação alguma. No máximo, usando por exemplo um recurso externo, como um Firewall, você pode permitir por exemplo apenas receber conexões FTP na porta 21 a partir de um ou mais endereços de rede, e apenas isso.

Para atender a necessidade de permitir ou restringir operações por usuário, existe a necessidade de desligar o acesso anônimo, configurar algumas chaves adicionais na seção [FTP], e criar algumas funções AdvPL no repositório para serem acionadas por estas chaves. Vamos direto para o exemplo completo:

[ftp]
Enable=1
Port=21
Path=c:\Protheus12LG\EnvLight\ftp
RPCEnv=envlight
CheckPassword=U_FTPPASS
GetUserPath=U_FTPPATH
CheckUserOper=U_FTPOPER

Primeiramente, removemos o acesso anônimo. Então, criamos uma chave chamada RPCENV, onde colocamos o nome  do environment (ambiente) existente neste Protheus Server, responsável por executar as funções AdvPL que serão colocadas para validar algumas operações do FTP.

Configuração CHECKPASSWORD

Quando um usuário conectar no FTP e informar o usuário e senha, será chamada a função U_FTPPASS(), que receberá como parâmetros o usuário e senha informados pelo cliente de FTP. Se esta função retornar .T., o Protheus Server responde ao cliente de FTP que o login foi aceito, caso contrário responde uma mensagem de erro e nega o acesso. Vejamos o exemplo abaixo:

User Function FTPPass(cUser,cPass)
cUser := lower(cUser)
if ( cUser == "root" )
  if( cPass == "root" )
    Return .T.
  Endif
Endif
Return .F. 

Neste exemplo, permitimos apenas um usuário chamado “root”, com a senha “manager”  a entrar no FTP.

Configuração GETUSERPATH

Imagine que, eu quero fornecer, por exemplo, uma pasta raiz de FTP diferenciada para alguns usuários. Para isso, eu crio uma função AdvPL — no nosso exemplo, USER FUNCTION FTPPATH(), que recebe como parâmetros o usuário e senha informados no login. A função deve retornar um PATH completo no servidor onde está sendo executado o Protheus Server, e esta pasta será o diretório raiz de FTP. Vamos ao exemplo:

User Function FTPPath(cUser,cPass)
cUser := lower(cUser)
If cUser == "siga0984"
  return "C:\Protheus12LG\ftp"
Endif
Return "C:\Protheus12LG\ftp\anonymous"

Neste caso, quando o usuário de FTP for “siga0984“, ele têm acesso à pasta raiz do FTP, quando qualquer outro usuário somente terá acesso a partir da pasta “anonymous”.

Configuração CHECKUSEROPER

Caso você queira permitir UPLOAD de arquivos no FTP, ou outras operações que modifiquem conteúdo, como apagar arquivo, criar ou apagar uma pasta, é necessário implementar uma função AdvPL para ser chamada pelo Protheus Server para autorizar estas operações, usando a configuração CheckUserOper — no nosso exemplo, vamos implementar a função U_FTPOPER(). Ela recebe três parâmetros: O usuário de login no FTP Server, a senha utilizada, e o comando enviado pelo Cliente do FTP.

Apenas alguns comandos são desviados para esta função, por exemplo STOR <arquivo>, DELE <arquivo>, MKD <pasta>,  RMD <pasta>, e dois comandos não implementados para renomear arquivo (RNFR e RNTO).

  • STOR = Upload de arquivo
  • DELE = Apagar arquivo
  • MKD = Criar pasta 
  • RMD = Remover pasta
  • RNFR <arquivo1> e RNTO <arquivo2> — Renomar arquivo1 para arquivo2

Caso a função AdvPL retorne .T., a operação é autorizada. Caso contrário, negada. Vamos ao nosso exemplo:

User Function FTPOPER(cUser,cPass,cOper)
Local cCmd
cUser := lower(cUser)
If cUser == 'root'
  cCmd := left(cOper,4)
  If cCmd $ "STOR,DELE"
    Return .T.
  Endif
Endif
Return .F.

No exemplo acima, permitimos apenas ao usuário “root” a possibilidade de fazer upload ou mesmo de apagar um arquivo remotamente.

Resultados dos Testes

Os testes realizados mostraram que alguns clientes de FTP, por exemplo o WINSCP, usou uma sintaxe para a troca de pasta (comando CWD) que o FTP Server do Protheus não entendeu, mas funcionou adequadamente com o cliente FTP nativo do Windows em linha de comando, e um cliente de FTP do Altap(r) Salamander.

Mesmo com as implementações em AdvPL, o objetivo de ter um servidor nativo de FTP no servidor Protheus é atender a necessidade de integrações entre sistemas, normalmente em ambientes restritos — ou fechados. Ele não oferece logs de utilização nativos, não permite interceptar outros comandos para implementar por exemplo restrição de acesso de usuário para uma pasta ou arquivo, etc.

Devido a questões ligadas a implementação do FTP em múltiplas plataformas, é recomendado usar os nomes de arquivos sem espaços em branco, sem acentuação, e com letras minúsculas, e utilizar sub-pastas se e somente se realmente necessário. Qualquer demanda maior, que exija mais controles, como um FTP publicado na Internet para clientes e parceiros ter acesso a múltiplos arquivos, eu pessoalmente recomendo a utilização de uma aplicação especializada em ser Servidor de FTP, que vai lhe oferecer nativamente muito mais controles do que o Protheus Server como FTP Server.

Conclusão

Para cada tamanho de problema, existe uma solução adequada. O Protheus como servidor de FTP não foi criado para competir com um FTP Server de mercado, mas apenas para ter uma alternativa simples e nativa para integração entre sistemas, onde não são necessários níveis muito avançados de controle. Porém, para o que ele se propõe, ele dá conta do recado.

Em um próximo post, vamos explorar a classe client de FTP do Protheus Server —  chamada TFTPCLIENT() — para conectar e realizar operações de Cliente de FTP conectando-se em um FTP Server configurado também no Protheus.

Agradeço novamente a audiência, e desejo a todos TERABYTES DE SUCESSO !!!

Referências

 

 

Dicas valiosas de programação – Parte 04

Introdução

Continuando o assunto de dicas valiosas de programação, vamos abordar alguns assuntos relacionados a JOBS (Programas sem interface), pontos de atenção, alternativas de controle, etc.

Considerações sobre JOBS

Em tópicos anteriores, vimos que existem várias formas de subir um ou mais jobs em um serviço do Protheus Server. A maior dificuldade dos JOBS consiste em saber o que ele está fazendo, e como ele está fazendo. O fato do Job não ter nenhum tipo de interface torna esse trabalho um pouco diferente dos demais programas.

Quando usamos um pool de JOBS, como por exemplo os processos de WebServices ou de portais WEB (JOB TYPE=WEBEX), definimos o número inicial (mínimo) de processos, numero máximo, e opcionalmente mínimo livre e incremento. Logo, não precisamos nos preocupar se o servidor recebe mais uma requisição e todos os processos que estão no ar estão ocupados — se o número máximo de processos configurado não foi atingido, o próprio Protheus Server coloca um ou mais jobs no ar.

Gerando LOG de um JOB

Normalmente quando precisamos acompanhar o que um determinado JOB está fazendo, podemos usar o IDE e/ou TDS para depurar o Job, ou caso isto não seja uma alternativa para a questão, o programa pode ser alterado para emitir mensagens a cada etapa de processamento. Uma das alternativas normalmente usadas — e mais simples de usar — é usar a função AdvPL conout() nos programas envolvidos, para registar no log de console do Protheus Server mensagens sobre o que cada processo está fazendo. Para diferenciar os processos, podemos usar a função ThreadID() do AdvPL, para identificar o número da thread que gerou a mensagem.

Outra alternativa interessante, inclusive mais interessante que usar o log de console do servidor de aplicação, é fazer com que o job crie um arquivo de LOG dele próprio em disco, usando por exemplo a função fCreate(), criando o arquivo em uma pasta a partir do RootPath do ambiente, usando por exemplo um prefixo mais o numero da thread atual mais o horário de inicio do job como nome do arquivo — para ficar fácil saber quais logs são de quais JOBS — e gravar os dados de LOG dentro desse arquivo usando a função fWrite()  — lembrando de inclusive gravar os caracteres chr(13)+chr(10) ao final de cada linha — estes caracteres de controle indicam uma quebra de linha em um arquivo no padrão Windows. Para Linux, a quebra de linha padrão é apenas chr(10).

Acompanhando a execução de um JOB

Quando você cria um determinado JOB para alguma tarefa longa, pode ser interessante saber em que ponto ou etapa da tarefa o JOB está trabalhando em um determinado momento. A solução mais leve, é você criar um nome de uma variável global — aquelas que são acessadas através das funções PutGlbVars() e GetGlbVars() — e alimentar dentro do JOB a variável global com a etapa atual do processo, enquanto um outro programa (em outro processo, com interface por exemplo) consulta a variável para saber qual é a tarefa interna do Job em andamento.

Desta forma, um programa externo pode consultar — através de variáveis globais com nomes pré-definidos — o status de não apenas um, mas vários jobs sendo executados no servidor de aplicação atual. Basta criar identificadores únicos não repetidos antes de iniciar os processos.

Ocorrências de Erro Críticas

Mesmo que o seu JOB possua um tratamento de erro, cercado com BEGIN SEQUENCE … END SEQUENCE e afins, as ocorrências de erro de criticidade mais alta não são interceptadas ou tratadas. Desse modo, se você apenas consulta uma variável global para pegar o status de um Job, ele pode ter sido derrubado ou ter finalizado com uma ocorrência critica de erro, e o programa que está esperando ou dependendo de um retorno dele nem sabe que ele já não está mais sendo executado.

Não há contorno para tentar manter no ar um JOB que foi finalizado por uma ocorrência crítica, porém você pode descobrir se ele ainda está no ar ou não, usando alguns recursos, por exemplo:

  1. Além da variável global para troca de status, faça o JOB obter por exemplo um Lock Virtual no DBAccess ou um Lock em Disco — busque no blog por “MUTEX” e veja algumas alternativas. A ideia é usar um recurso nomeado em modo exclusivo, que é liberado automaticamente caso o JOB seja finalizado por qualquer razão. Se o seu programa que espera retorno do JOB está sem receber nenhuma atualização, verifique se o JOB está no ar tentando fazer um bloqueio do recurso que o JOB está usando. Se o seu processo conseguiu o bloqueio, o JOB foi pro vinagre…
  2. Verifique se o seu processo ainda está no ar usando — com moderação — por exemplo a função GetUserInfoArray() — ela retorna um array com as informações dos processos em execução na instância atual do Protheus Server. Para isso, pode ser necessário que o JOB que foi colocado em execução use uma variável global para o processo principal e de controle de jobs saber qual é o ThreadID deste processo, para ser possível um match com o retorno da GetUserInfoArray().

Seu processo principal pode não saber o que aconteceu com o processo filho, mas sabe que ele não está mais no ar, e saiu antes de dar um resultado. Isso muitas vezes é suficiente para você estudar uma forma de submeter o processo novamente, ou de encerrar o processo principal informando que houve um término anormal e os logs de erro do sistema devem ser verificados, ao invés de esperar para sempre um JOB que já não está mais lá.

Conclusão

Quanto mais nos aprofundamos em um tema, mais temas aparecem para nos aprofundarmos 🙂 E, é claro que veremos exemplos de uso práticos destes mecanismos, com fonte e tudo, nos próximos posts !!!

Agradeço novamente a audiência, e desejo a todos(as) TERABYTES DE SUCESSO !!! 

Referências