R/10_scraping_html_folhapessoal.R

#' @title Função que executa as requisições do Web Scraping
#'
#' @description Realiza as requisições das Páginas (HTML)
#' que tem a Folha de pessoal dos Municípios no site do TCM-ba.
#' 
#' @param repetir É definido "SIM" como padrão. Mas pode ser marcado como "NAO",
#' caso não deseje repetir as consulta do Web Scraping que falharam ou que não foram
#' identificadas resposta do ente municipal no dia de execução do Web Scraping
#' 
#' @param sgbd Define o Sistema de Banco de Dados a ser utilizado. Por padrão, é definido como sqlite
#'
#' @importFrom magrittr %>%
#'
#' @export

executar_scraping_html_folhapessoal <- function(repetir = "SIM",
                                                sgbd = "sqlite") {


  if(repetir == "SIM") {

    tb_requisicoes <- DBI::dbReadTable(tcmbapessoal::connect_sgbd(sgbd),
                                       "tabela_requisicoes") %>%
                      tibble::as_tibble() %>%
                      dplyr::filter(status_request_html == "N" | status_request_html == "R") %>%
                      dplyr::arrange(dplyr::desc(data), cod_entidade)
    
    DBI::dbDisconnect(tcmbapessoal::connect_sgbd(sgbd))

  } else {
    
    tb_requisicoes <- DBI::dbReadTable(tcmbapessoal::connect_sgbd(sgbd),
                                       "tabela_requisicoes") %>%
      tibble::as_tibble() %>%
      dplyr::filter(status_request_html == "N") %>%
      dplyr::arrange(dplyr::desc(data), cod_entidade)
    
    DBI::dbDisconnect(tcmbapessoal::connect_sgbd(sgbd))

  }

    print("Iniciando Web Scraping dos arquivos HTML das Despesas")
    
    #Variável alocada no ambiente global (com: '<<-') para servir de contador de requisição
    n_requisicao <<- 1L
    
    #Variável alocada no ambiente global (com: '<<-') para ser utilizado no contador de requisição
    total_requisicao <<- nrow(tb_requisicoes)

    print(paste("Total de Resquisições:", total_requisicao))
    


    purrr::pwalk(tb_requisicoes, scraping_html_folhapessoal, sgbd)


    message("O Web Scraping dos arquivos HTML das Despesas foi concluído")
    
    # Rotina para remove as variáveis alocadas no ambiente global
    rm(n_requisicao, total_requisicao, envir = globalenv())

}


######################################################################################


scraping_html_folhapessoal <- function(id, data, ano, mes, cod_municipio, nm_municipio,
                                       cod_entidade, nm_entidade, status_request_html,
                                       log_request_htm, nm_arq_html, hash_arq_html,
                                       status_tratamento_arq_csv, log_tratamento_arq_csv,
                                       nm_tratamento_arq_csv, sgbd = "sqlite", ...) {

    subdir_resposta_html_mun <- file.path("resposta_scraping_html",
                                          tcmbapessoal::limpar_nome(nm_municipio))

    subdir_resposta_html_entidade <- file.path("resposta_scraping_html",
                                               tcmbapessoal::limpar_nome(nm_municipio),
                                               tcmbapessoal::limpar_nome(nm_entidade))

    if (dir.exists(subdir_resposta_html_mun) == FALSE) {
        dir.create(subdir_resposta_html_mun)
    }

    if (dir.exists(subdir_resposta_html_entidade) == FALSE) {
        dir.create(subdir_resposta_html_entidade)
    }


    parametros <- list(municipios = cod_municipio,
                       txtEntidade = nm_entidade,
                       entidades = cod_entidade,
                       ano = ano,
                       mes = mes,
                       tipoRegime = "",
                       cdFuncao = "",
                       pesquisar = "Pesquisar")


    scraping_html_purrr <- purrr::safely(httr::POST)

    scraping_html <- scraping_html_purrr(tcmbapessoal::url_tcm(),
                                         body = parametros,
                                         encode = 'form',
                                         httr::timeout(50))

    log_request <- tcmbapessoal::log_data_hora()


    if (is.null(scraping_html$result) == TRUE) {

        message("#### Erro: 'Timeout' da Primeira tentativa para: ",
                nm_entidade, " ano: ", ano, " mês:", mes, " ####")
        
      tcmbapessoal::gravar_erro(log_request = log_request,
                                nm_log_erro = "timeout - primeira tentativa",
                                entrada = scraping_html,
                                id = id,
                                cod_entidade = cod_entidade,
                                nm_entidade = nm_entidade,
                                ano = ano, 
                                mes = mes,
                                outros = "",
                                sgbd = sgbd
                                )
      
        message("#### Iniciando Segunda tentativa para: ",
                nm_entidade, " ano: ", ano, " mês:", mes, " ####")

        # Pausa antes da segunad tentativa
        Sys.sleep(10)


        # Segunda tentativa. Se houver timeout novamente, pular para a próxima requisição.
        scraping_html <- scraping_html_purrr(tcmbapessoal::url_tcm(),
                                             body = parametros,
                                             encode = 'form',
                                             httr::timeout(75))

        log_request <- tcmbapessoal::log_data_hora()

        if (is.null(scraping_html$result) == TRUE) {
          
            tcmbapessoal::gravar_erro(log_request = log_request,
                                      nm_log_erro = "timeout - segunda tentativa",
                                      entrada = scraping_html,
                                      id = id,
                                      cod_entidade = cod_entidade,
                                      nm_entidade = nm_entidade,
                                      ano = ano,
                                      mes = mes,
                                      outros = "",
                                      sgbd = sgbd
                                      )
  
              # Parar a iteração e pular para a próxima requisição
              return(message("#### Erro: 'Timeout' da Segunda tentativa para: ",
                             nm_entidade, " ano: ", ano, " mês:", mes, " ####"))

        }
        

    }


        # Verifica se há erro de querisição 404. Se sim, grava o erro numa tabela de log no BD.
        if (scraping_html$result$status_code == 404) {

            tcmbapessoal::gravar_erro(log_request = log_request,
                                      nm_log_erro ="erro - 404",
                                      entrada = scraping_html,
                                      id = id,
                                      cod_entidade = cod_entidade,
                                      nm_entidade = nm_entidade,
                                      ano = ano,
                                      mes = mes,
                                      outros = "",
                                      sgbd = sgbd
                                      )
            
            # Parar a iteração e pular para a próxima requisição.
            return(message("#### Erro 404 de Requisição para: ",
                           nm_entidade, " ano: ", ano, " mês:", mes, " ####"))

        }


    nm_arq_html <- file.path(subdir_resposta_html_entidade,
                             paste0(ano,
                                    "-",
                                    mes,
                                    "-",
                                    cod_entidade,
                                    "-",
                                    stringr::str_sub(
                                      tcmbapessoal::limpar_nome(nm_entidade),
                                      end = 60),
                                    ".html"))


    salvar_html <- xml2::read_html(scraping_html$result) %>%
                   rvest::html_node("#formConsulta") %>%
                   xml2::write_html(nm_arq_html)

    hash_arq_html <- digest::sha1(nm_arq_html)

    
    detectar_tabela <- xml2::read_html(scraping_html$result) %>%
                       rvest::html_node("#tabelaConsulta") %>%
                       is.na()

    update_sqlite <- purrr::safely(DBI::dbExecute)

    if (detectar_tabela == FALSE) {

       result_sql <- update_sqlite(tcmbapessoal::connect_sgbd(sgbd), 'UPDATE tabela_requisicoes
                                                        SET status_request_html = "S",
                                                            log_request_html = :log_request,
                                                            nm_arq_html = :nm_arq_html,
                                                            hash_arq_html = :hash_arq_html,
                                                            status_tratamento_arq_csv = "N"
                                                        WHERE id = :id
                                                                    ;',
                                       params = list(log_request = as.character(log_request),
                                                     nm_arq_html = as.character(nm_arq_html),
                                                     hash_arq_html = as.character(hash_arq_html),
                                                     id = as.character(id)))

       DBI::dbDisconnect(tcmbapessoal::connect_sgbd(sgbd))


                  while(is.null(result_sql$result) == TRUE) {
          
                      print("Banco de Dados bloqueado - Tentando conectar novamente...")
          

                      result_sql <- update_sqlite(tcmbapessoal::connect_sgbd(sgbd), 'UPDATE tabela_requisicoes
                                                                    SET status_request_html = "S",
                                                                        log_request_html = :log_request,
                                                                        nm_arq_html = :nm_arq_html,
                                                                        hash_arq_html = :hash_arq_html,
                                                                        status_tratamento_arq_csv = "N"
                                                                    WHERE id = :id
                                                                                ;',
                                      params = list(log_request = as.character(log_request),
                                                    nm_arq_html = as.character(nm_arq_html),
                                                    hash_arq_html = as.character(hash_arq_html),
                                                    id = as.character(id)))
            
                      DBI::dbDisconnect(tcmbapessoal::connect_sgbd(sgbd))
          
                  }
       

      # n_requisicao e total_requisicao são variáveis alocadas no ambiente global
      # para ser usada como contador das requisições. Não é a melhor prática no
      # paradgima da programação funcional, mas o propósito foi alcançado
       
      print(paste("Scraping - (R:",
                  paste0(n_requisicao,"/",total_requisicao),
                  ") | -",
                  ano, "-",
                  mes, "-",
                  tcmbapessoal::limpar_nome(nm_entidade),
                  "- OK"))
      
      # Variável que está no ambiente global e
      n_requisicao <<- n_requisicao + 1


    } else {

          result_sql <- update_sqlite(tcmbapessoal::connect_sgbd(sgbd), 'UPDATE tabela_requisicoes
                                                            SET status_request_html = "R",
                                                                log_request_html = :log_request,
                                                                nm_arq_html = :nm_arq_html,
                                                                hash_arq_html = :hash_arq_html
                                                            WHERE id = :id
                                                                        ;',
                          params = list(log_request = as.character(log_request),
                                        nm_arq_html = as.character(nm_arq_html),
                                        hash_arq_html = as.character(hash_arq_html),
                                        id = as.character(id)))
    
          DBI::dbDisconnect(tcmbapessoal::connect_sgbd(sgbd))


                  while(is.null(result_sql$result) == TRUE) {
          
                      print("Banco de Dados bloqueado - Tentando conectar novamente...")
          
                      result_sql <- update_sqlite(tcmbapessoal::connect_sgbd(sgbd), 'UPDATE tabela_requisicoes
                                                                    SET status_request_html = "R",
                                                                        log_request_html = :log_request,
                                                                        nm_arq_html = :nm_arq_html,
                                                                        hash_arq_html = :hash_arq_html
                                                                    WHERE id = :id
                                                                                ;',
                                      params = list(log_request = as.character(log_request),
                                                    nm_arq_html = as.character(nm_arq_html),
                                                    hash_arq_html = as.character(hash_arq_html),
                                                    id = as.character(id)))
            
                      DBI::dbDisconnect(tcmbapessoal::connect_sgbd(sgbd))
          
                  }
          
          
        message(paste("Scraping - (R:",
                      paste0(n_requisicao,"/",total_requisicao),
                      ") | -",
                      ano, "-",
                      mes, "-",
                      tcmbapessoal::limpar_nome(nm_entidade),
                      "- NAO INFORMADO"))
        
        n_requisicao <<- n_requisicao + 1

    }
}
georgevbsantiago/tcmbapessoal documentation built on June 10, 2019, 9:42 a.m.