CRUD em AdvPL – Parte 11

Introdução

Gostou de localizar o endereço do contato da Agenda com o Google Maps ? Você usa G-Mail? Que tal apertar mais um botão na agenda, e o programa abrir o seu navegador de internet para você enviar um e-mail para um contato?

Mais um Botão

Na mesma linha do post anterior, apenas mais um botão, que somente estará ativo na tela caso o campo e-Mail do contato esteja preenchido.

@ 110,05 BUTTON oBtnMail PROMPT "G-Mail" SIZE 60,15 ;
   WHEN !empty(cEMAIL) ; 
   ACTION SendMail(cEMAIL) OF oPanelNav PIXEL
aadd(aBtns,oBtnMap) // [14] e-Mail

Agora, vamos criar a função que abre o Browse. Para este truque funcionar, você deve ser um usuário do G-Mail, e estar autenticado com a sua conta do Google no Browse. A URL não poderia ser mais simples:

STATIC Function SendMail(cEMAIL)
Local cMailURL := 'https://mail.google.com/mail/?view=cm&fs=1&tf=1&to='
shellExecute("Open", cMailURL+lower(cEMAIL), "", "", 1 )
Return

Agora, após abrir a consulta da agenda, e encontrar o contato para o qual você deseja enviar o e-mail, basta acionar o botão “G-Mail”:

GRud - Mail 1

Ao acionar o botão “G-Mail”, o seu navegador de internet padrão deve ser aberto, com a interface de envio de uma nova mensagem do G-Mail, já com o e-mail do destinatário preenchido. Basta colocar o assunto, preencher o corpo do e-Mail e enviar 😀

Crud - Mail 2

Outas formas de envio

Agradecendo a dica do Izac Ciszevski, por que não abrir uma janela de diálogo usando um componente de Browser do próprio SmartClient, como por exemplo o TIBrowser() ou o TWebEngine()? Claro, apenas trocamos a função SendMail(), vamos ver como fica:

STATIC Function SendMail(cEMAIL)
Local cMailURL := 'https://mail.google.com/mail/?view=cm&fs=1&tf=1&to='
Local oDlgMail
Local oWebBrowse
Local cTitle := "Enviar eMail ("+Alltrim(Lower(cEMAIL))+")"

DEFINE DIALOG oDlgMail TITLE (cTitle) ;
   FROM 0,0 TO 600,800 PIXEL

oWebBrowse := TWebEngine():New(oDlgMail, 0, 0, 100, 100)
oWebBrowse:Align := CONTROL_ALIGN_ALLCLIENT
oWebBrowse:Navigate(cMailURL+Alltrim(lower(cEMAIL)))

ACTIVATE DIALOG oDlgMail CENTER

Return

Resolvi montar o exemplo sobre a TWEBEngine() mesmo, pois inclusive ela não exige nenhuma configuração adicional no SmartClient, o que não é o caso da TIBrowser(). No primeiro acesso, tive que me autenticar no GMAIL, e uma vez autenticado, o recurso funcionou como o esperado.

Para ver maiores detalhes sobre a documentação das classes acima, consulte os links de referência no final do post, inclusive verifique que a classe TWebEngine() é mais recente, mas apenas está disponível a partir do APPServer Build 7.00.170117A.

Conclusão

As vezes os recursos mais legais e úteis de um programa são os mais simples. Com apenas meia dúzia de linhas, um botão e uma STATIC Function, e está feita mais uma integração usando um serviço do Google !!!

Desejo novamente a todos TERABYTES de SUCESSO !!!

Referências

 

Anúncios

CRUD em AdvPL – Parte 10

Introdução

No último post, acrescentamos um botão de pesquisa de CEP. Agora, que tal mostrarmos o endereço do contato em foco no Google Maps? Vai ser mais rápido e fácil do que você imagina!

Crud - Mapa

Acrescentando mais um botão

No menu de ações do lado direito da tela, vamos acrescentar um botão chamado “Mapa”:

@ 95,05 BUTTON oBtnMap PROMPT "Mapa" SIZE 60,15 ;
   ACTION ShowMap(oDlg,aBtns,aGets) OF oPanelNav PIXEL
aadd(aBtns,oBtnMap) // [13] Mapa

Agora, vamos criar a função que vai fazer a mágica. É mais simples do que parece.

STATIC Function ShowMap(oDlg,aBtns,aGets)
Local nPos
Local cEndereco
Local cCidade
Local cUF
Local cCEP
Local cMapsURL := 'https://www.google.com/maps/search/?api=1&query='
Local cUrlQry := ''

// Busca nos GETS os campos para montar uma Query de busca
// de endereço para o Google Maps

nPos := ascan(aGets , {|x| x[1] == "ENDER" } )
cEndereco := alltrim(Eval( aGets[nPos][2]:bSetGet ))
If !empty(cEndereco)
   cUrlQry += UrlEscape(cEndereco+',')
Endif

nPos := ascan(aGets , {|x| x[1] == "CIDADE" } )
cCidade := alltrim(Eval( aGets[nPos][2]:bSetGet ))
If !empty(cCidade)
   cUrlQry += UrlEscape(cCidade+',')
Endif

nPos := ascan(aGets , {|x| x[1] == "UF" } )
cUF := Eval( aGets[nPos][2]:bSetGet )
If !empty(cUF)
   cUrlQry += UrlEscape(cUF+',')
Endif

nPos := ascan(aGets , {|x| x[1] == "CEP" } )
cCep := alltrim(Eval( aGets[nPos][2]:bSetGet ))
If !empty(cCidade)
   cUrlQry += UrlEscape(cCEP)
Endif

If Empty(cUrlQry)
  MsgStop("Nao há dados preenchidos suficientes para a busca.")
  Return
Endif

// Ao sumbeter uma URL, o sistema operacional abre o navegador 
// padrão com o endereço fornecido
shellExecute("Open", cMapsURL+cUrlQry, "", "", 1 )

Return

Simples assim, ao estar posicionado em um contato da agenda, você clica no botão “Mapa”, e caso pelo menos alguma informação do endereço esteja preenchida, ela será usada para montar uma URL abrindo o Google Maps, para fazer a busca do endereço fornecido.  E, como os dados do formulário podem conter caracteres especiais que devem entrar como informações dentro da URL, usamos a função URLEscape(), também acrescentada no código, vide fonte abaixo:

STATIC Function UrlEscape(cInfo)
cInfo := strtran(cInfo,'%',"%25")
cInfo := strtran(cInfo,'&',"%26")
cInfo := strtran(cInfo," ","+")
cInfo := strtran(cInfo,'"',"%22")
cInfo := strtran(cInfo,'#',"%23")
cInfo := strtran(cInfo,",","%2C")
cInfo := strtran(cInfo,'<',"%3C")
cInfo := strtran(cInfo,'>',"%3E")
cInfo := strtran(cInfo,"|","%7C")
Return cInfo

Existem mais caracteres que poderiam ser tratados, mas para uma versão inicial, um tratamento básico é suficiente.

Conclusão

Não é legal apertar um botão em uma agenda e abrir um mapa mostrando onde fica o endereço ? Antes da Internet, você teria que fazer — ou comprar feito — algum software especifico — e provavelmente caro — para fazer algo assim. Hoje, a sua aplicação não precisa fazer tudo por ela mesma, usar APIs prontas e outros recursos — a maioria deles gratuito (desde que não utilizados para fins comerciais) — torna uma aplicação mais completa, amigável, agrega valor, atrai usuários, enfim…. 🙂

Novamente desejo a todos TERABYTES DE SUCESSO !!

Referências

TDN – ShellExecute

 

 

CRUD em AdvPL – Parte 09

Introdução

Em cada post sobre o CRUD, vamos melhorando partes do código e acrescentando funcionalidade. Neste tópico, vamos acrescentar uma Busca de CEP na Internet, para fazer o preenchimento automático de alguns campos do endereço.

Botão de Consulta de CEP

Para disparar a busca, vamos aproveitar o valor preenchido no campo GET de CEP da Interface, adicionando um botão com o título “Buscar CEP”, porém vamos usar uma pré-validação do Botão — propriedade bWhen do Objeto, acessada pelo comando @…BUTTON através da instrução WHEN <condição>. Quando a expressão usada na condição do botão for verdadeira, o botão torna-se ativo. Caso contrário, ele é desativado. Vamos ao fonte:

(...)
@ 110,60 GET oGet8 VAR cCEP PICTURE "@R 99999-999" ;
   SIZE CALCSIZEGET(9),12 OF oPanelCrud PIXEL

// Habilita a busca de CEP com um botão do lado do GET
// O Botão somente está disponível caso o oGet8 ( campo CEP )
// estiver habilitado para edição
@ 110,110 BUTTON oBtnCEP PROMPT "Buscar CEP" SIZE 60,14 ;
   WHEN (oGet8:LACTIVE) ; 
   ACTION BuscaCEP(oDlg,aBtns,aGets) OF oPanelCrud PIXEL

// Novos campos inseridos em 07/10
(...)


Para que o botão de Busca de CEP somente esteja ativo quando o GET do CEP estiver ativo, usamos a propriedade lActive do objeto GET do CEP (oCep) como condição WHEN do botão.

Função BuscaCEP()

A função de busca de CEP vai verificar se o CEP digitado está completo, rodar uma segunda função para buscar os dados do endereço daquele CEP na Internet, e validar o retorno. Caso os dados sejam buscados com sucesso, o programa mostra os dados encontrados e pergunta se ele deve atualizar os campos de endereço do formulário com os dados obtidos. Vamos ao fonte:

/* ---------------------------------------------------
Botão para busca de CEP e preenchimento de campos 
de endereço automaticamente. 
--------------------------------------------------- */
Static Function BuscaCEP(oDlg,aBtns,aGets)
Local nPos , cCEP
Local cJsonCEP
Local oJsonObj
Local aJsonFields := {}
Local nRetParser := 0
Local oJHashMap
Local lOk
Local cCEPEnder := ''
Local cCEPBairro := ''
Local cCepCidade := ''
Local cCEPUF := ''
Local lCEPERRO := .F.

// Busca o campo CEP nos Gets e recupera o valor informado
nPos := ascan(aGets , {|x| x[1] == "CEP" } )
cCep := Eval(aGets[nPos][2]:bSetGet)
cCep := alltrim(cCep)

// Verifica se o valor informado está completo - 8 dígitos
IF len(cCEp) < 8
  MsgStop("Digite o número do CEP completo para a busca.","CEP Inválido ou incompleto")
  Return
Endif

// Busca o CEP usando uma API WEB
// Em caso de sucesso, a API retorna um JSON
// Em caso de falha, uam string vazia
cJsonCEP := WebGetCep(cCEP)

If !empty(cJsonCEP)
  // Caso o CEP tenha sido encontrado, chama o parser JSON
  oJsonObj := tJsonParser():New()
  // Faz o Parser da mensagem JSon e extrai para Array (aJsonfields)
  // e cria tambem um HashMap para os dados da mensagem (oJHM)
  lOk := oJsonObj:Json_Hash(cJsonCEP, len(cJsonCEP), @aJsonfields, @nRetParser, @oJHashMap)
  If ( !Lok )
    MsgStop(cJsonCEP,"Falha ao identificar CEP",cCEP)
  Else
    // Obtem o valor dos campos usando o Hashmap gerado
    HMGet(oJHashMap, "erro", @lCEPERRO)
    if lCEPERRO
      MsgStop("CEP Inexistente na Base de Dados","Falha ao buscar CEP "+cCEP)
    Else
      HMGet(oJHashMap, "logradouro", @cCEPEnder)
      HMGet(oJHashMap, "bairro", @cCEPBairro)
      HMGet(oJHashMap, "localidade", @cCepCidade)
      HMGet(oJHashMap, "uf", @cCEPUF)
      cCEPEnder := padr(upper(cCEPEnder) ,50)
      cCEPBairro := padr(upper(cCEPBairro),30)
      cCepCidade := padr(upper(cCepCidade),40)
      cCEPUF := padr(Upper(cCEPUF) ,2)

      IF MsgYesNo("Endereço ... "+cCEPEnder + chr(10) + ;
        "Bairro ..... "+cCEPBairro + chr(10) + ;
        "Cidade ..... "+cCEPCidade+ chr(10) + ;
        "Estado ..... "+cCepUF+ chr(10) + ;
        "Deseja atualizar o formulário com estes dados?","CEP encontrado")

        nPos := ascan(aGets , {|x| x[1] == "ENDER" } )
        Eval(aGets[nPos][2]:bSetGet , cCEPEnder )
        nPos := ascan(aGets , {|x| x[1] == "BAIRR" } )
        Eval(aGets[nPos][2]:bSetGet , cCEPBAirro )
        nPos := ascan(aGets , {|x| x[1] == "CIDADE" } )
        Eval(aGets[nPos][2]:bSetGet , cCepCidade )
        nPos := ascan(aGets , {|x| x[1] == "UF" } )
        Eval(aGets[nPos][2]:bSetGet , cCepUF )
      Endif
    Endif
  Endif
  // Limpa os objetos utilizados
  FreeObj(oJsonObj)
  FreeObj(oJHashMap)
Endif
Return

A função WebGetCep() recebe como parâmetro o CEP a ser pesquisado, em formato cartactere. Ela será a responsável bor buscar o CEP na Internet, usando a API oferecida pelo site viacep.com.br — vide deetalhes nas referências no final desse post.

Em caso de indisponibilidade do serviço, a função WebGetCep() deve retornar uma string vazia. Caso contrário, ela retorna uma string em formato JSON, que modemos parsear usando uma classe nativa do AdvPL, que retorna um objeto HashMap, para acelerar a busca pelas informações desejadas. Como a API já tem um formato pré-definido de retorno, basta procurarmos as condições que nos interessam.

Função WebGetCep()

Essa aqui é a responsável pela “mágica” — a chamada da API WEB disponível através de um método GET em HTTP, usando a função HttpGet() do AdvPL, e tratando um possível retorno de erro. Vamos ao código:

STATIC Function WebGetCep(cCEP)
Local cUrl , cJsonRet
Local nCode , cMsg := ''
// Montando a URL de pesquisa
cUrl := 'http://viacep.com.br/ws/'+cCEP+'/json/'
// Buscando o CEP
cJsonRet := httpget(cUrl)
// Verificando retorno 
If empty(cJsonRet)
  nCode := HTTPGETSTATUS(@cMsg)
  MsgStop(cMsg+" ( HTTP STATUS = "+cValToChar(nCode)+" )","Falha na Busca de CEP")
Endif
Return cJsonRet

A função é bem simples, a requisição também, e o tratamento de erro mais ainda. Caso a requisição volte um conteúdo vazio, pode ser uma indisponibilidade do serviço ou da conexão com a internet, seja o que for, o status de erro é recuperado pela função HttpGetStatus().

Busca de CEP funcionando

Primeiro entramos na agenda, acionamos a consulta, mostramos um registro desejado e clicamos em “Alterar” :

CRUD - Busca CEP 1.png

Feito isso, vamos digitar um CEP, por exemplo 18603-730, e clicamos no botão “Buscar CEP”. Caso a busca de CEP tenha sido executada com sucesso, devemos ver na tela a seguinte mensagem:

CRUD - Busca CEP 2

Vamos confirmar a operação, clicando em “Yes”, e vamos ver como ficou a tela com os dados do contato — os dados destacados em vermelho foram alterados.

CRUD - Busca CEP 3

Agora, basta clicar em “Salvar” para persistir as alterações deste contato no Banco de Dados.  😀

Conclusão

Com um fonte modularizado, fica fácil acrescentar novas funcionalidades sem ter que virar o código original do avesso.  Nos próximos posts, vamos começar a separar o processamento dos dados, e tentar deixar as funcionalidades do código mais dinâmicas.

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

Referências

 

CRUD em AdvPL – Parte 08

Introdução

Prontos para mais um capítulo da novela do CRUD? Neste post vamos fazer algumas alterações no layout dos componentes, e acrescentar as funcionalidades de busca indexada por ID e NOME e mudança de ordem de consulta. O fonte completo está disponível no GITHUB, link disponível no final do post.

Alteração da disposição dos componentes

Os botões de navegação “Primeiro”, “Anterior”, “Próximo” e “Último”, que antes eram dispostos horizontalmente na parte de baixo do formulário de campos da Agenda, serão remanejados para a direita do formulário, verticalmente, e com o espaço que ganhamos, vamos acrescentar mais alguns botões.

Crud V2 Consulta

Para isso ser feito de forma simples, primeiro criamos um painel a mais na caixa de diálogo, e colocamos seu alinhamento à direita.

@ 0,0 MSPANEL oPanelNav OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelNav:ALIGN := CONTROL_ALIGN_RIGHT

Agora, todos os botões de navegação, inclusive os novos botões de consulta e ordem, são acrescentados neste painel. Praticamente aproveitamos todas as coordenadas dos botões do menu de opções do painel esquerdo, afinal as coordenadas dos componentes são sempre relativas à coordenada 0,0 (canto superior esquerdo) do seu container — no caso um objeto tPanel.

// Cria os Botões de Navegação Livre
@ 05,05 BUTTON oBtnFirst PROMPT "Primeiro" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,7,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnFirst) // [7] Primeiro

@ 020,05 BUTTON oBtnPrev PROMPT "Anterior" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,8,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnPrev) // [8] Anterior

@ 35,05 BUTTON oBtnNext PROMPT "Próximo" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,9,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnNext) // [9] Proximo

@ 50,05 BUTTON oBtnLast PROMPT "Último" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,10,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnLast) // [10] Último

@ 65,05 BUTTON oBtnPesq PROMPT "Pesquisa" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,11,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnPesq) // [11] Pesquisa

@ 80,05 BUTTON oBtnOrd PROMPT "Ordem" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,12,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnOrd) // [12] Ordem

A função ManAgenda() agora passa a receber as ações 11 (Pesquisa) e 12 (Ordem). Logo, teremos que implementar estas ações. Mas antes tem uma parte do código que podemos simplificar.

Escondendo os botões de navegação

Na versão anterior do programa Agenda, os botões de navegação eram criados a partir do painel de visualização e edição de registros da agenda (oPanelCrud), e para esconder ou mostrar os botões de navegação, era necessário endereçar cada botão individualmente. Dessa forma, o fonte de ligar e desligar os botões de navegação ficaria assim:

// -------------------------------------------------
// Habilita ou desabilita os botões de navegação
// -------------------------------------------------
STATIC Function SetNavBtn(aBtns,lEnable)
IF lEnable
  aBtns[7]:Show() // Primeiro
  aBtns[8]:Show() // Anterior
  aBtns[9]:Show() // Proximo
  aBtns[10]:Show() // Ultimo
  aBtns[11]:Show() // Pesquisa
  aBtns[12]:Show() // Ordem
Else
  aBtns[7]:Hide() // Primeiro
  aBtns[8]:Hide() // Anterior
  aBtns[9]:Hide() // Proximo
  aBtns[10]:Hide() // Ultimo
  aBtns[11]:Hide() // Pesquisa
  aBtns[12]:Hide() // Ordem
Endif
Return

Agora, que os botões de navegação estão dentro de um painel, podemos simplesmente esconder ou mostrar o painel de navegação inteiro, apenas com uma instrução. E nós não precisamos sequer passar o objeto do Painel como parâmetro, veja a nova função abaixo:

STATIC Function SetNavBtn(aBtns,lEnable)
Local oPanel := aBtns[7]:oParent 
If lEnable
  oPanel:Show()
Else
  oPanel:Hide()
Endif
Return

Desta forma, pegamos o objeto apenas do sétimo botão — botão “Primeiro” — e através dele pegamos o objeto do componente onde ele foi criado usando a propriedade oParent. Assim, conseguimos esconder e mostrar o painel inteiro — e automaticamente todos os componentes criados dentro dele.

Podemos também, ao invés de esconder e mostrar o painel, podemos desabilitar o painel, de modo que o painel e seus componentes fiquem visíveis, mas não possam ser acionados. Neste caso, o fonte ficaria assim:

STATIC Function SetNavBtn(aBtns,lEnable)
Local oPanel := aBtns[7]:oParent
oPanel:SetEnable(lEnable)
Return

Definindo a ordem de consulta

Quando entramos na opção de consulta, a aplicação troca a ordem de navegação da tabela — usando a função DbSetOrder() — para ordem alfabética pelo nome do contato da agenda, usando o índice criado a partir do campo NOME. Quando confirmamos a inclusão de um novo registro, a ordem pode ser alterada para ID, caso seja necessário determinar o último número registrado na Agenda para incrementar e gerar o próximo ID.

Neste momento, vamos criar um recurso para permitir mudar por nossa conta a ordem de navegação da tabela em modo de consulta, mas antes precisamos mostrar em algum lugar qual a ordem que está sendo utilizada atualmente.

Painéis e alinhamentos

Vamos criar um painel superior, dentro da área usada para os campos do formulário, e dentro dele vamos colocar a informação da ordem em uso. Vamos aproveitar a possibilidade de criar um painel dentro de outro, para criar um painel central, onde hoje é criado o painel para CRUD, e dentro desse painel central, colocamos um painel com alinhamento superior, para colocar a informação sobre a ordenação do arquivo, e na área que sobrou, colocamos o painel do CRUD. A implementação ficaria dessa forma:

@ 0,0 MSPANEL oPanelMenu OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelMenu:ALIGN := CONTROL_ALIGN_LEFT

@ 0,0 MSPANEL oPanelNav OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelNav:ALIGN := CONTROL_ALIGN_RIGHT

@ 0,0 MSPANEL oPanelCenter OF oDlg SIZE 700,600 COLOR CLR_WHITE,CLR_LIGHTGRAY
oPanelCenter:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 0,0 MSPANEL oPanelOrd OF oPanelCenter SIZE 100,20 COLOR CLR_WHITE,CLR_BLUE
oPanelOrd:ALIGN := CONTROL_ALIGN_TOP

@ 0,0 MSPANEL oPanelCrud OF oPanelCenter SIZE 700,600 COLOR CLR_WHITE,CLR_LIGHTGRAY
oPanelCrud:ALIGN := CONTROL_ALIGN_ALLCLIENT

Reparem que os painéis oPanelCrud e oPanelOrd são criados a partir do oPanelCenter, que pega todo o espaço da DIALOG que sobrou depois de alinhar o painel oPanelMenu à esquerda e o oPanelNav a direita.

Se você pensar bem, criar um painel superior para mostrar a ordem de índice … não é um tiro de canhão para matar uma mosca ? Não necessariamente, afinal para eu criar este objeto TSAY na parte superior, dentro do painel do CRUD, seria necessário realinhar todos os componentes mais pra baixo, para abrir espaço para este TSAY. Da forma que foi feita, eu não precisei alterar nenhuma coordenada, apenas criei a sequência de painéis, e se amanhã eu achar que a ordem fica mais legal em baixo, basta eu mudar o alinhamento do painel, simples assim.

Mostrando a ordem de consulta atual

Dentro do painel oPanelOrd, vamos colocar um componente visual para informar a ordenação atual de consulta do arquivo. Neste caso, vamos usar um objeto tSay:

// Mostra Ordenação atual do arquivo de agenda
@ 5,5 SAY oSayOrd PROMPT " " SIZE 100,12 COLOR CLR_WHITE,CLR_BLUE OF oPanelOrd PIXEL
oSayOrd:SetText("Ordem .... "+ AGENDA->(IndexKey()))

Na abertura do programa, a tabela AGENDA é aberta com o ALIAS “AGENDA”, então para simplificar a implementação, eu apenas seto o texto do objeto tSay para colocar a chave de índice da ordem atual da tabela, obtida com a função IndexKey(). Logo, a nova tela de abertura da Agenda deve ficar assim:

Crud V2 Entrada

As trocas de ordem do arquivo são feitas dentro da função ManAgenda(), mas o componente de interface que mostra a ordem é um Objeto TSay, que não é passado como parâmetro. Logo, vamos passar ele como um novo parâmetro para a função ManAgenda(), e atualizá-lo quando necessário, usando a mesma fórmula anteriormente usada, mas sendo executada para pegar o estado atual.

Mudando a Ordem

Pensando novamente em solução SIMPLES, a ação do botão “Ordem” deve apenas trocar a ordem para ID ou NOME. Existem inúmeras formas de se fazer isso, porém como o objetivo é ser simples, e são apenas 2 ordens para escolher, eu optei pela implementação mais simples:

(...)
ElseIf nAction == 12 // Troca de Ordem
   IF ChangeOrd(oDlg)
      // Se a ordem foi trocada 
      // Atualiza texto com a chave do indice em uso 
      oSayOrd:SetText("Ordem .... "+ AGENDA->(IndexKey()))
   Endif
Else 
(...)

E, para permitir a escolha, a nova função ChangeOrd()

Static Function ChangeOrd(oDlg)
Local nOrdAtu := AGENDA->(IndexOrd())
Local nNewOrd := 0
If nOrdAtu == 1 
  If MsgYesNo("Deseja alterar para ordem de NOME ?")
    nNewOrd := 2
  Endif
Else
  If MsgYesNo("Deseja alterar para ordem de ID ?")
    nNewOrd := 1
  Endif
Endif
if ( nNewOrd > 0 ) 
  AGENDA->(DBSETORDER(nNewOrd))
  Return .T.
Endif
return .F.

Implementando a Busca sobre o índice

E, para finalizar, vamos fazer a busca rápida sobre o índice, na ação 11. Para isso, vamos perguntar ao operador do programa, o que ele procura. A ordem de busca usada será a ordem atual. Primeiro, dentro da função ManAgenda(), vamos inserir a execução da ação 11 — Pesquisa.

(...)
ElseIf nAction == 11 // Pesquisa Indexada

   // Realiza a busca pelo índice atual 
   PesqIndeX(oDlg)

   // Atualiza na tela o conteúdo do registro atual 
   ReadRecord(aGets)

Else
(...)

Agora, vamos implementar a funcionalidade de busca, acrescentando as duas funções abaixo:

STATIC Function PesqIndeX(oDlgParent)
Local oDlgPesq 
Local cTitle
Local cStrBusca
Local nTamanho
Local nRecSave 
Local lFound := .F.
Local cIndexFld := AGENDA->(Indexkey())
Local oGet1 , oBtn1

// Monta titulo da janela de pesquisa
cTitle := 'Pesquisa por '+ cIndexFld

// Guarda numero do registro atual 
nRecSave := AGENDA->(Recno())

If indexord() == 1 // Campo ID
  nTamanho := 6
  cStrBusca := space(nTamanho)
  cPicture := "@9"
ElseIf indexord() == 2 // Campo NOME
  nTamanho := 50
  cStrBusca := space(nTamanho)
  cPicture := "@!"
Endif

DEFINE DIALOG oDlgPesq TITLE (cTitle) ;
   FROM 0,0 TO 120,415 PIXEL;
   OF oDlgParent ; 
   COLOR CLR_BLACK, CLR_LIGHTGRAY

@ 05,05 GET oGet1 VAR cStrBusca PICTURE (cPicture) SIZE CALCSIZEGET(nTamanho) ,12 OF oDlgPesq PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
   ACTION IIF( SeekAgenda(cIndexFld,cStrBusca) , (lFound := .T. , oDlgPesq:End()) , oGet1:SetFocus() ) OF oDlgPesq PIXEL

ACTIVATE DIALOG oDlgPesq CENTER

If !lFound
   // Nao achou, volta ao registro antes da busca 
   AGENDA->(dbgoto(nRecSave))
Endif

Return

// Ajusta o valor informado na tela de acordo com o campo / indice 
// para fazer a busca corretamente
STATIC Function SeekAgenda(cIndexFld,cStrBusca)
IF cIndexFld == 'ID'
   cStrBusca := strzero(val(cStrBusca),6)
ElseIF cIndexFld == 'NOME'
   cStrBusca := alltrim(cStrBusca)
Endif
If !DbSeek(cStrBusca)
   MsgStop("Informação não encontrada.","Busca por ["+cStrBusca+"]")
   Return .F.
Endif
return .T.

Funcionamento e considerações

A função de busca utilizada  — DBSeek() — vai posicionar no primeiro registro que satisfazer a chave informada. No caso no NOME, pode ser informado apenas uma ou mais primeiras letras do nome, e se houver um nome que comece com estas letras, ele será o registro que vai ser trazido na tela.

Caso a informação não seja encontrada, será exibida uma mensagem, e o programa retorna para a tela de entrada de valor de busca, para você alterar o valor informado ou digitar um valor novo. Caso o registro seja encontrado, a janela fecha sozinha, e o registro encontrado é trazido na tela.

Conclusão

Daqui a pouco esse CRUD vira um produto … e ainda têm muito mais para ser explorado. Quer a versão atualizada desse código ? Acesse o GITHUB na URL https://github.com/siga0984/Blog e faça download do arquivo AGENDA.PRW — devidamente atualizado. Basta compilar, e chamar a função U_AGENDA diretamente no SmartClient.

Referências

 

CRUD em AdvPL – Parte 07

Introdução

Continuando a sequência de posts relacionados ao CRUD em Advpl, onde criamos um exemplo de programa de Agenda, nesse post vamos olhar mais de perto a geração do ID na inclusão de dados da Agenda, como o ERP Microsiga usa sequenciadores nas tabelas de dados, e como podemos fazer um sequenciador em memória para a Agenda.

Interface de Inclusão – Gerador de ID

Passando rapidamente o olho no fonte, ela parece em ordem. Os identificadores de registro (ID) da Agenda são criados protegidos por um semáforo (ou MUTEX), sempre pegamos o último registro usando o índice por ID — Ordem 1 — e acrescentamos uma unidade. Perfeito, certo ?

Não é bem assim. Ao excluir um registro da agenda usando a aplicação, o registro é marcado para deleção — através da função DbDelete() — e devido ao filtro para ignorar registros marcados para deleção nas operações de busca e navegação da tabela — ligado no inicio da aplicação com o comando SET DELETED ON —  o registro marcado para exclusão não é mais visível nas consultas.  Como o primeiro contato com ID 000004 está deletado — ou marcado para deleção — no momento que eu vou inserir um novo contato, a rotina de geração de ID pega o último registro ATIVO da tabela — estamos desconsiderando deletados — lê o valor do registro, e incrementa uma unidade — gerando novamente o ID 000004.

Podemos arrumar isso de uma forma bem simples, apenas desligando o filtro para ignorar registros deletados — usando o comando SET DELETED OFF — e no final da rotina, depois de gerar o novo número, ligar o filtro novamente.

Como a numeração sequencial é feita no ERP ?

Imagine cada inserção feita em uma tabela com um campo com sequência incremental, precisar ir no Banco de Dados, posicionar e ler o último registro para gerar o próximo identificador da sequência ? É um desperdício de requisições, além de ser necessário um MUTEX bloqueando a inserção até ela ser concluída.

Para contornar isso, foram criadas no ERP duas tabelas de controle e reserva de sequência, chamadas de SXE e SXF. A idéia é simples, uma controla todos os registros de sequenciadores do ERP, e a outra controla as reservas de sequência — um processo pode reservar uma sequência para uso, e não confirmar o uso da sequência, então ela torna-se disponível para a próxima inserção, evitando intervalos vazios ou “buracos” nas sequências.

A implementação e a ideia são excelentes, porém com o aumento do número de tabelas do ERP, e todos os sequenciadores sendo controlados pelo mesmo arquivo, a quantidade de acesso a disco por processos concorrentes usando as sequências poderia gerar filas de acesso ao disco no sistema operacional, deixando o sistema lento.

Para resolver isso, o mecanismo de sequenciamento e reserva de sequências foi transferido para dentro do Servidor de Licenças do ERP, onde as sequências são controladas em memória, sem acesso a disco. Com isso, apenas a primeira geração do registro de controle da sequência precisa fazer um acesso a disco, ir no final da tabela, ler o último código, e criar o registro de sequenciamento. A partir de então, usando as mesmas funções de encapsulamento disponibilizadas pelo Framework AdvPL do ERP, as próximas requisições de um novo identificador da sequência são feitas para o Servidor de Licenças, de forma muito rápida, evitando acesso a disco desnecessário, e como todo o controle de sequenciamento é feito na memória, o tempo que a lista permanece bloqueada para a geração do identificador é ridículo.

Construindo um sequenciador para a Agenda

Partindo ainda da premissa que o programa de AGENDA será executado por hora apenas por um servidor de aplicação, podemos usar por exemplo uma variável global para guardar o último número gerado da agenda, e quando for realizada uma inclusão, resgatamos o número da memória, acrescentamos uma unidade, e atualizamos a variável global. Dessa forma, mesmo com múltiplas threads, cada uma delas ficará bloqueada para gerar um novo identificador por um tempo ínfimo, e a sequência sempre fica na memória, enquanto o servidor estiver no ar. Vamos ver como ficaria a função GetNewID() usando essa abordagem:

 

STATIC Function GetNewID()
Local cLastID,cNewId
Local nRetry := 0
While !GlbNmLock("AGENDA_ID")
   // Espera máxima de 1 segundo, 20 tentativas 
   // com intervalos de 50 milissegundos 
   nRetry++
   If nRetry > 20
      return ""
   Endif
   Sleep(50)
Enddo
cLastID := GetGlbValue("AGENDA_SEQ")
If Empty(cLastID) 
  // Somente busco na Tabela se eu nao tenho o valor na memoria
  DBSelectArea("AGENDA")
  DbsetOrder(1)
  DBGobottom()
  cLastId := AGENDA->ID
Endif
cNewId := StrZero( val(cLastID) + 1 , 6 )
PutGlbValue("AGENDA_SEQ",cNewID)
GlbNmUnlock("AGENDA_ID")
Return cNewId

Reparem como o fonte ficou praticamente do mesmo tamanho que era antes, porém agora seu comportamento está muito — muito mesmo — mais optimizado. Na primeira execução do programa, a variável global AGENDA_SEQ não existe em memória, logo a aplicação busca o último registro do banco de dados. Caso a global já exista, o valor do último ID utilizado é recuperado da memória. Então, criamos o novo ID, atualizamos a variável global de memória com este valor, soltamos o bloqueio nomeado obtido, e retornamos o número para a rotina de inserção.

Diferença de Tempo

Fazendo um teste de inserção usando uma função de teste sem interface, no meu ambiente consegui inserir 10 mil registros em pouco mais de 10 segundos — aproximadamente 1000 registros por segundo — inserindo apenas ID e um nome aleatório. Usando a rotina de geração de ID proposta, lendo os valores da memória, o tempo baixou de 10,5 s. para 5,5 s. — praticamente duas vezes mais rápido. Segue abaixo a função de testes utilizada:

User Function TesteAg1()
Local nI, nTimer
OpenAgenda()
nTimer := seconds()
For nI := 1 to 10000
  cNewId := GetNewID()
  dbappend()
  agenda->ID := cNewId
  agenda->NOME := cvaltochar(str(seconds()*1000))
  DBRUnlock()
Next
conout("Tempo de Insert = "+str(seconds()-nTimer,12,3)+' s.')
return

Esta função foi acrescentada ao fonte AGENDA.PRW, e executada de modo direto. Como a função OpenAgenda() não depende de nada, podemos chamá-la diretamente no nosso teste, para abrir a tabela de AGENDA e usá-la diretamente. Caso você querida fazer o teste comparativo, recomendo renomear a função original GetNewID() para GetNewId1(), inserir a nova como GetNewId2(), e chavear isso no programa de testes, rodando uma vez com dada função para verificar a diferença de tempo.

Restrição Operacional

Naturalmente, devido ao escopo da variável de memória global ser apenas a instância atual do serviço atual do Protheus Server, este tipo de semáforo em memória somente poderia ser usado por exemplo em um ambiente com balanceamento de carga — e consequentemente múltiplos serviços — caso este controle fosse centralizado em um serviço dedicado, e os demais serviços consumissem estas funções fazendo chamadas remotas (RPC Nativo do AdvPL, por exemplo).

Conclusão

Por hora, nada mais a acrescentar. Ao testar a agenda, já encontrei outros pontos que precisam de ajustes, vamos deixar as conclusões para o próximo post.

Desejo a todos novamente TERABYTES de SUCESSO 😀

Referências

 

CRUD em AdvPL – Parte 06

Introdução

Neste post, vamos dar uma incrementada na Agenda, acrescentando 3 novos campos —  FONE1, FONE2 e EMAIL — fazendo mínimas alterações no código, e alterando a estrutura da tabela AGENDA no Banco de Dados.

Inserindo novos campos na Agenda

Pode parecer complicado, mas algumas partes do programa Agenda.PRW já foram criadas pensando em haver mudanças ou novas implementações. Para acrescentarmos mais campos na tabela de Agenda, vamos aproveitar a função separada de criação da tabela e índices, para também verificar e alterar a estrutura da tabela atual caso ela já exista sem estar com nas novas colunas.

Primeira parte – Interface

Acrescentar os novos campos na interface é a parte mais simples. Criamos novos objetos de GET, colocamos eles nos Arrays de controle, criamos as posições de interface, aumentamos 50 pixels na altura da janela, deslocamos todos os botões de navegação, confirmar e voltar 50 pixels para baixo, e declaramos as variáveis a serem usadas. Como a passagem de parâmetros para as funções de controle sempre passam o Array com os objetos GET, nenhuma passagem de parâmetros adicional foi necessária.

Local cFone1 := Space(20)
Local cFone2 := Space(20)
Local cEmail := Space(40)
// Novos campos inseridos em 07/10
@ 125,60 GET oGet9 VAR cFone1 PICTURE "@!" SIZE CALCSIZEGET(20),12 OF oPanelCrud PIXEL
@ 140,60 GET oGetA VAR cFone2 PICTURE "@!" SIZE CALCSIZEGET(20),12 OF oPanelCrud PIXEL
@ 155,60 GET oGetB VAR cEMAIL PICTURE "@!" SIZE CALCSIZEGET(40),12 OF oPanelCrud PIXEL
// Novos campos inseridos em 07/10
aadd( aGets , {"FONE1" , oGet9 , space(20) } )
aadd( aGets , {"FONE2" , oGetA , space(20) } )
aadd( aGets , {"EMAIL" , oGetB , space(40) } )

Segunda parte – tabela AGENDA

O programa trabalha com uma tabela de dados criada em um Banco de Dados relacional acessado pelo DBAccess. Originalmente estes campos não existiam na tabela, não há alteração, apenas acrescentar campos novos. Para esta tarefa, vamos usar a função TCAlter(), e mexer apenas na função de criação e abertura da tabela AGENDA — no nosso caso, a função OpenAgenda(), vide novo fonte abaixo:

STATIC Function OpenAgenda()
Local nH
Local cFile := "AGENDA"
Local aStru := {}
Local aDbStru := {}
Local nRet

// Conecta com o DBAccess configurado no ambiente
nH := TCLink()

If nH < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(nH))
  QUIT
Endif


// Cria o array com os campos 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})

// Novos campos inseridos em 07/10
aadd(aStru,{"FONE1" ,"C",20,0})
aadd(aStru,{"FONE2" ,"C",20,0})
aadd(aStru,{"EMAIL" ,"C",40,0})

If !tccanopen(cFile)

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

Else

  // O Arquivo já existe, vamos comparar as estruturas
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  aDbStru := DBStruct()
  USE

  If len(aDbStru) <> len(aStru)
    // O tamanho está diferente ? 
    // 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 AGENDA")
      QUIT
    Endif
    MsgInfo("Estrutura do arquivo AGENDA atualizada.")
  Endif

Endif

If !tccanopen(cFile,cFile+'_UNQ')
  // Se o Indice único da tabela nao existe, cria 
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  nRet := TCUnique(cFile,"ID")
  If nRet < 0 
    MsgSTop(tcsqlerror(),"Falha ao criar índice único")
    QUIT
  Endif
  USE
EndIf

If !tccanopen(cFile,cFile+'1')
  // Se o Indice por ID nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  INDEX ON ID TO (cFile+'1')
  USE
EndIf

If !tccanopen(cFile,cFile+'2')
  // Se o indice por nome nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  INDEX ON NOME TO (cFile+'2')
  USE
EndIf

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

If NetErr()
  MsgStop("Falha ao Abrir a Agenda em modo compartilhado.")
  QUIT
  Return .F. 
Endif

// Liga o filtro para ignorar registros deletados 
SET DELETED ON

// Abre os indices, seleciona ordem por ID
// E Posiciona no primeiro registro 
DbSetIndex(cFile+'1')
DbSetIndex(cFile+'2')
DbSetOrder(1)
DbGoTop()

Return .T.

Novo comportamento do fonte

A parte nova e interessante é avaliar a estrutura da tabela caso ela já exista. Usamos a função DBStruct() após abrir a tabela para verificar qual é a estrutura atual da tabela no Banco de Dados. E, na memória, verificamos o tamanho desta estrutura com o array aStru, que contém a lista de campos com a estrutura atual (nova) da tabela.

Caso os arrays estejam diferentes, a tabela existente no SGDB precisa de alteração para contemplar os novos campos. Neste caso, com a tabela FECHADA, chamamos a função TCAlter(), informando o nome da tabela a ser alterada, o array com a estrutura atual da tabela segundo o banco de dados, e o array com a nova estrutura.

Internamente, a função TCAlter() vai verificar as diferenças entre as estruturas — que no caso serão apenas a adição de novos campos — e o DBAccess vai definir a sequência de operações que serão submetidas ao Banco de Dados para acrescentar estas colunas,

Logo, no primeiro acesso ao fonte, as estruturas estarão diferentes, e o programa vai executar a TCAlter() para inserir os novos campos. Em uma segunda execução, as estruturas já terão o mesmo tamanho, e esta operação não será mais necessária.

Demais proteções

Ainda faltam no fonte algumas proteções básicas, como por exemplo:

  • Proteger a rotina de abertura de tabela com um MUTEX, para evitar que dois processos tentem ao mesmo tempo fazer a criação ou alteração da tabela, bem como a criação dos índices.
  • Proteger as tentativas de abertura de modo EXCLUSIVE da tabela para manutenção, verificando após cada tentativa se a tabela foi realmente aberta, verificando o retorno da função NETERR(), ou verificando o alias atual usando a função ALIAS().

Outros tipos de alteração estrutural

A função TCAlter() apenas repassa a tabela e as estruturas ao DBAccess, que avalia de acordo com o tipo do banco de dados em uso quais as etapas necessárias para fazer a tabela partir da estrutura atual para chegar na nova estrutura informada. A comparação entre as estruturas é feita baseado no nome do campo, e identifica os seguintes casos:

  1. Inclusão de novo campo — o campo existe no segundo array mas não existe no primeiro.
  2. Alteração de tipo de campo — o campo existe nos dois arrays, mas o tipo do campo está diferente. A troca de tipo de um campo numérico inteiro (sem decimais) para caractere realiza internamente a conversão dos dados, sem haver perda do conteúdo. Qualquer outra troca de tipo será tratada internamente como se a coluna fosse eliminada e criada novamente com o tipo novo, com seu conteúdo vazio (default).
  3. Alteração de tamanho de campo — o campo existe nos dois arrays, mas o tamanho foi aumentado ou diminuído — alguns bancos de dados não suportam que uma operação destas seja feita diretamente, principalmente a redução do tamanho do campo. Nestes casos, o DBAccess internamente realiza uma sequencia de etapas — de acordo com o banco de dados eu uso — para no final do processo conseguir fazer a alteração mantendo os dados originais da coluna. Em alguns bancos, pode ser necessário que o DBAccess faça um BACKUP interno da tabela, crie ela novamente com a nova estrutura, e importe novamente os dados da tabela de Backup no formato adequado.
  4. Exclusão da coluna – o campo existe no primeiro Array, mas não existe no segundo.

Conclusão

O programa de CRUD já está ficando mais esperto do que a sua primeira versão, e ainda existem muitas possibilidades de melhoria. Não há melhor aprendizado do que ter um bom programa de exemplo nas mãos, e entender por quê ele precisa evoluir, e como podemos fazer isso. Aguardem mais surpresas e recursos nos próximos posts do CRUD.

Desejo novamente a todos TERABYTES de SUCESSO !!!!

Referências

 

 

 

CRUD em AdvPL – Parte 04

Introdução

No post anterior, vimos alguns detalhes e possibilidades de melhoria no código do programa Agenda. Agora, vamos implementar algumas delas, e avaliar as implementações realizadas, e ver outras possibilidades.

Validação no GET

Existem várias formas de consistir ou validar se as informações necessárias para inserir ou alterar um registro da agenda estão sendo fornecidas, e dependendo da informação, podemos inclusive verificar se elas estão corretas.

Uma delas é realizar a consistência sob demanda, para cada campo informado no formulário. Conseguimos fazer isso através da cláusula “VALID” no comando @ ..  GET

Por exemlo, vamos alterar o GET do campo “UF” para o fonte abaixo:

@ 95,60 GET oGet7 VAR cUF PICTURE "!!" SIZE CALCSIZEGET(2) ,12 VALID VldUf(cUF) OF oPanelCrud PIXEL

Agora, vamos inserir no final do fonte a função de validação que acabamos de inserir a chamada para verificar o valor informado no GET:

// Release 1.1 
// Exemplo de validação do campo cUF ( Estado ou Unidade da Federação )

STATIC Function VldUf(cUF)
If Empty(cUF)
  // Estado nao informado / vazio / em branco 
  Return .T.
Endif
If cUF $ "AC,AL,AP,AM,BA,CE,DF,ES,GO,MA,MT,MS,MG,PA,PB,PR,PE,PI,RJ,RN,RS,RO,RR,SC,SP,SE,TO"
  // Estado digitado está na lista ? Beleza
  Return .T.
Endif

// Chegou até aqui ? O estado informado não é válido. 
// Mostra a mensagem e retorna .F., nao permitindo 
// que o foco seja removido do campo 
MsgSTop("Unidade da Federação inválida ou esconhecida : ["+cUF+"] - "+;
       "Informe um valor válido ou deixe este campo em branco.",;
       "Erro na Validação")

Return .F.

Quando você abrir o formulário de dados para incluir ou alterar um registro, uma vez que você dê foco no campo UF, somente será possível remover o foco do campo e executar qualquer outra ação neste formulário quando, ou o campo UF estiver vazio, ou preenchido com a sigla correta de um dos 27 estados do Brasil, contando com o Distrito Federal.

Criação de Novo ID na Inclusão

Como eu havia comentado no post anterior, se dois usuários abem ao mesmo tempo a tela de inclusão de novo registro na Agenda, ambas iriam pegar o último número da base + 1, e mostrá-lo na tela, sem permitir edição, e este valor fatalmente ficaria duplicado na base de dados se ambos os usuários confirmassem a inclusão.

Uma das formas mais “primitivas” de se evitar isso é criar uma função para retornar um novo ID para ser utilizado, e apenas fazer isso no momento efetivo de gravar um novo registro na agenda. Vamos ao fonte:

STATIC Function GetNewID()
Local cNewId
DBSelectArea("AGENDA")
DbsetOrder(1)
DBGobottom()
cNewId := StrZero( val(AGENDA->ID) + 1 , 6 )
Return cNewId

No exemplo acima, ainda temos um problema de concorrência: Se duas instâncias do programa confirmam uma inclusão de registro na agenda no mesmo instante, pode acontecer de ambos os processos pegarem o mesmo ID.

Para resolvermos esta questão, sem usar outro mecanismo para gerar o novo ID, a forma mais simples disso ser feito é utilizando um recurso de seção crítica ou MUTEX (Exclusão Mútua), para garantir  que nunca mais de um processo tempo realize as etapas de obter um novo número e incluir um novo registro ao mesmo tempo.

Assim, caso dois programas executassem a etapa de confirmação da Inclusão re registro, apenas um inciaria o processo, pegando o último número da base, somando uma unidade, utilizando este número na inclusão do novo registro, e somente quando a inclusão estivesse completa, o processo que ficou aguardando a finalização do primeiro pegaria o último número atualizado, para gerar um novo identificador.

O problema óbvio desse tipo de implementação é justamente o fato de você não mais permitir que duas inclusões ocorram em paralelo, apenas uma inclusão por vez pode ser feita. Quando falamos de uma agenda de contatos pessoal, onde praticamente não há concorrência, a geração de dois IDs iguais pode simplesmente não ocorrer, ou acontecer muito esporadicamente. Agora, quando falamos de sistemas transacionais com grandes volumes de dados, precisamos tomar cuidado quanto optamos por tornar um acesso a uma operação sequencial. Sem possibilidade de paralelismo, fatalmente ele vai atingir um limite de operações por segundo usando um processo único.

MUTEX em AdvPL

Existem algumas formas de implementar ou emular um semáforo ou um MUTEX em AdvPL. Algumas considerações básicas sobre cada implementação é o quando “custa” de recursos para a implementação, e qual é o escopo ou abrangência dela.

Semáforo em Disco

Uma forma simples de implementar um semáforo de escopo global, que pode ser visto e compartilhado entre vários servidores de aplicação em um ambiente, é usar as funções de baixo nível de arquivos do AdvPL (FCreate, FOpen, FClose), e criar um arquivo no disco em uma pasta a partir do ROOTPATH do ambiente.

Ao criar um arquivo com a função FCreate(), mesmo que nada seja escrito nele, em caso de sucesso na operação, o arquivo criado permanece aberto em modo exclusivo pelo processo que o criou, podendo ser fechado explicitamente pela função FClose() ou implicitamente no final do processo — inclusive caso o processo seja finalizado de forma elegante (fim da rotina) ou em caso de erro.  Vamos a um exemplo:

User Function Mutex1()
Local nHnd 

nHnd := fCreate('\semaforo\mutex1.lck')

If nHnd >= 0 
   // ------------------------------
   // Arquivo criado com sucesso e aberto em modo exclusivo. 
   // Mesmo que o arquivo já exista no disco, se ele não estiver
   // em uso ou aberto por nenhuma rotina, a função FCreate() 
   // consegue recriar o arquivo. 
   // Desta forma, o que você rodar dentro desse bloco de fonte
   // não será executado por mais de um usuário ao mesmo tempo 

   MsgInfo("Bloqueio obtido. Continue o programa para soltar o bloqueio")

   // Aqui deve rodar o código que não pode rodar 
   // ao mesmo tempo por mais de um usuário 

   FClose(nHnd)
   MsgInfo("Bloqueio liberado.")

Else

   MsgStop("Nao é possível criar/abrir o arquivo de bloqueio.")

Endif

Return

Comportamento esperado

Ao subir um SmartClient rodando o programa U_MUTEX1, ele deve conseguir fazer o bloqueio. Ao aparecer a janela com a mensagem  “Arquivo Bloqueado”, inicie uma segunda instância do SmartClient executando o mesmo programa. Você deve receber a mensagem “Não é possível criar/abrir o arquivo de bloqueio.” Somente será possível um outro SmartClient obter o bloqueio após o primeiro programa ter fechado o arquivo com FClose() ou ter terminado.

Detalhes da implementação

O diretório usado como “Raiz” ou RootPath do ambiente deve ser visível e o mesmo para um determinado ambiente ou Environment em execução no Protheus Server. Inclusive, quando usados mais de um serviço de Protheus Server, o RootPath do ambiente deve ser compartilhado com os demais Slaves do Protheus usando o sistema de compartilhamento de arquivos do sistema operacional em uso. Logo, o escopo dessa implementação global entre ambientes que acessam o mesmo RootPath. 

O peso dessa implementação é um ponto importante. O Excesso de acesso ao sistema de arquivos em disco do servidor pode gerar fila de acesso a disco, caso este recurso seja usado muitas vezes por segundo, para realizar bloqueios curtos de operações concorrentes. Recomenda-se evitar o uso deste tipo de semáforo.

Outro ponto é que este semáforo é do tipo “espera ocupada”, isto é, se você não conseguiu criar o arquivo, pois outro processo está acessando o mesmo em modo exclusivo, você vai ter que repetir a operação quantas vezes for necessário até que você tenha o bloqueio. Isso aumenta mais ainda o custo da implementação, pois o seu processo poderia estar fazendo outra coisa ao invés de tentar até conseguir o bloqueio do arquivo.

Lock Virtual nomeado no DBAccess

Caso sua aplicação use o DBAccess, existe uma forma de criar um bloqueio nomeado virtual, usando as funções TCVLock() e TCVunlok(). O bloqueio é compartilhado entre todas as conexões com o DBAccess feitas para o mesmo ambiente / DSN. Da mesma forma que usamos o sistema de arquivos, podemos usar um lock nomeado no DBAccess.

User Function Mutex2()
Local nHTop

nHTop := tcLink()
IF nHTop < 0 
   MsgStop("Falha de conexão com DBAccess -- Erro "+cValToChar(nHTop))
   return
Endif

If TCVLock('MUTEX2')
  // ------------------------------
  // Bloqueio nomeado criado no DBaccess em memória

  MsgInfo("Bloqueio obtido. Continue o programa para soltar o bloqueio")

  // Aqui deve rodar o código que não pode rodar 
  // ao mesmo tempo por mais de um usuário 

  TCVUnlock('MUTEX2')

  MsgInfo("Bloqueio liberado.")

Else

  MsgStop("Nao foi possível adquirir o bloqueio.")

Endif

TCUnlink(nHTop)
Return

Comportamento esperado

De forma similar ao outro bloqueio, ambos são modelos de espera ocupada ou bloqueio ativo. Não há tempo de espera para obter o bloqueio, caso o identificador nomeado de bloqueio esteja em uso por outro processo, a função TCVLock() retorna .F. imediatamente.

Este bloqueio é um pouco mais leve do que o bloqueio em Disco, pois usa a conexão de rede entre o Protheus Server e o DBAccess. Essa solução é mais interessante do que usar o bloqueio com o arquivo em disco, e atende com louvor a necessidade da Agenda.

Bloqueio usando Framework do ERP

O Framework do ERP Microsiga possui uma função de lock nomeado genérica para ser usada para bloqueios de escopo global, onde parametrizamos inclusive se o escopo do bloqueio deve ser restrito a empresa e filial do usuário atual do sistema. As funções se chamam LockByName() e UnlockByName(), estão documentadas na TDN, e internamente elas utilizam funções internas do servidor de licenças do ERP Microsiga para gerenciar a lista de bloqueios nomeados na memória do license server. Porém, este tipo de bloqueio exige que a aplicação AdvPL em uso esteja utilizando as funções do Framework do ERP Microsiga relacionadas a criação de um contexto de execução do ERP, como a função RpcSetEnv() ou o comando PREPARE ENVIRONMENT, ou que você execute a sua aplicação a parir do Menu do ERP — onde o processo já têm um contexto de execução preparado para você usar as funções do Framework.

Outros MUTEX em AdvPL

Existe um bloqueio global, em memória, com escopo apenas do servidor de aplicação, usando as funções AdvPL GlbLock() e GlbUnlock() — porém este bloqueio não é nomeado. Desse modo, ele somente pode ser usado por uma rotina. Após 2016 foram criadas novas funções de Bloqueio com o mesmo escopo, porém são bloqueios nomeados, usando as funções GlbNmLock() e GlbNmUnlock(). Estas funções estão documentadas na TDN, em uma seção dedicada a funções de sincronismo, vide link nas referências no final do post.

Conclusão

Um processo de melhoria contínua de um sistema normalmente é baseado no crescimento deste sistema, e das adequações que devem ser feitas nos programas para eles suportarem este crescimento. Como a melhor solução é aquela que atende a sua necessidade, com o crescimento do sistema, as necessidades podem mudar, ou surgirem novas. Quanto mais conhecimento da linguagem e da plataforma você tiver, mais fácil será avaliar entre as possibilidades de implementação, qual delas que melhor lhe atende.

No próximo post desta sequência, vamos ver como usar os índices criados no programa Agenda para realizar buscas de dados usando o índice, com exemplos e as respectivas explicações 🙂

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

Referências