#' Clients HTTP génériques (réutilisables) suppressPackageStartupMessages({ library(httr) library(jsonlite) library(tidyverse) }) source(here::here("R/common/prepare_data.R")) source(here::here("R/common/environment.R")) #' Fonction d'appel des webservices http_get <- function(url, method = "GET", params = NULL, headers = NULL, auth = NULL, timeout_sec = 500) { req <- httr::VERB( verb = method, url = url, query = if (method == "GET") params else NULL, body = if (method != "GET") params else NULL, encode = "json", httr::add_headers(.headers = headers), httr::timeout(timeout_sec), if (!is.null(auth)) httr::authenticate(auth$user, auth$password) else NULL ) # Si HTTP status >= 400 => stop() automatique httr::stop_for_status(req) txt <- httr::content(req, as = "text", encoding = "UTF-8") if (!nzchar(txt)) { stop("HTTP_OK_BUT_EMPTY: la réponse est vide (pas de contenu).") } jsonlite::fromJSON(txt, simplifyVector = TRUE) } #' Renvoie les animaux utilisé dans éCow pour un cheptel #' @param num_cheptel Code du cheptel avec le FR #' @return Liste de vache, Liste de taureaux, liste de produits et liste de petits produits get_cheptel_ecow <- function(num_cheptel){ url_active_by_chep <- paste0(server_path, "webresources/animals/findInventaireEcowByChep/") active_by_chep <- http_get(url = paste0(url_active_by_chep, num_cheptel)) donneuses <- active_by_chep$donneuses active_by_chep$donneuses <- NULL # Nettoyage des données pour les listes reçues active_by_chep <- lapply(active_by_chep, clean_data_anims) active_by_chep$donneuses <- donneuses return(active_by_chep) } #' Renvoie la liste des adhérents HBC actifs dans Dolibarr #' @return Liste d'adhérents get_all_adherents_active <- function(){ url_adh_active_hbc <- paste0(server_path,"webresources/dolibarr/membersActiv") activ_adh <- http_get(url = url_adh_active_hbc) } #' Renvoie la liste des cheptels suivis par un technicien #' @param tech character. Identifiant à 5 lettres du technicien #' @return Liste de cheptels get_cheptels_by_tech <- function(tech){ url_cheps_tech <- paste0(server_path,"app/cheptelApp/getListeCheptelByTech/") activ_adh <- http_get( url = paste0(url_cheps_tech,tech) ) } #' Renvoie la liste des certificats zoo totaux (Vivants + semences + embryons) #' @return Liste de cz get_cztotaux <- function(){ url_czAV <- paste0(server_path,"webresources/zootechnique/getListCertifsAV/all") czAV <- http_get(url = url_czAV) url_czS <- paste0(server_path,"webresources/zootechnique/getListCertifsS/all") czS <- http_get(url = url_czS) url_czE <- paste0(server_path,"webresources/zootechnique/getListCertifsE/all") czE <- http_get(url = url_czE) c(czAV$animal, czS$animal, czE$animalo) } ########################################################################################### # Retourne les informations de connection à la base get_db_connection <- function() { do.call(DBI::dbConnect, infos_con) } # Fonction pour vérifier si un cheptel a déjà des données cheptel_has_ponderation <- function(con, num_cheptel) { query <- paste0( "SELECT count(*) FROM hbc.ecow_ponderations WHERE cheptel = '", num_cheptel,"'" ) count <- dbGetQuery(con, query)$count return(count > 0) } #' Met en forme les données issues de la BDD pour qu'elles soient directement interrogeable #' format_ponderation <- function(df) { df %>% mutate(sous_categorie = ifelse(is.na(sous_categorie), "NA", sous_categorie)) %>% group_by(categorie, sous_categorie) %>% summarise(valeurs = list(as.list(setNames(valeur, variable))), .groups = "drop") %>% group_by(categorie) %>% summarise( sous_cats = list( if (n() == 1 && first(sous_categorie) == "NA") valeurs[[1]] # Pas de sous-catégorie : retourne la liste nommée else setNames(valeurs, sous_categorie) # Avec sous-catégories : liste de listes nommées ), .groups = "drop" ) %>% deframe() %>% map(~ if (is.list(.x) && length(.x) == 1 && names(.x) == "NA") .x[[1]] else .x) } #' Renvoie la liste des paramètres de pondération pour un éleveur #' @param num_cheptel character. Numero de cheptel avec le FR get_params_ponderation <- function(num_cheptel){ num_cheptel <- 'FR03142115' con <- get_db_connection() # Si le cheptel n'a pas de paramètres de pondération personnalisés, on récupère ceux par défaut if (!cheptel_has_ponderation(con, num_cheptel)) { num_cheptel <- 'default' } # Récupérer les données query <- paste0("SELECT categorie, sous_categorie, variable, valeur FROM hbc.ecow_ponderations WHERE cheptel = '", num_cheptel,"'") data <- dbGetQuery(con, query) dbDisconnect(con) return(format_ponderation(data)) } ####################################################################################################### ###################### Rien a voir avec ecow - WS pedigree de Pauline ################################# fake <- function(){ library(httr) library(jsonlite) animalIds <- c("FR7122418163","FR7122406165", "FR7122363258", "FR7122234414", "FR0311285868", "FR7122363239", "FR7122363251", "FR7122380260", "FR7122380284", "FR7122363268") body <- list( animalsIds = animalIds, #nbGenerations = 5, voieFemelle = TRUE, cheptel = "FR71499477" ) response <- POST( #url = "https://tomcat.herdbookcharolais.com/HbcSchedulerAndServices-2.0-SNAPSHOT/webresources/animals/getpedigreebyanimlist/", url = "http://localhost:8080/HbcSchedulerAndServices/webresources/animals/getpedigreebyanimlist", body = toJSON(body, auto_unbox = TRUE, null = "null"), encode = "json" ) animalIds <- c("FR0800761491","FR0800761869") body <- list( animalsIds = animalIds, voieFemelle = TRUE, cheptel = "FR08021009" ) response <- POST( #url = "https://tomcat.herdbookcharolais.com/HbcSchedulerAndServices-2.0-SNAPSHOT/webresources/animals/getfondatrices/", url = "http://localhost:8080/HbcSchedulerAndServices/webresources/animals/getfondatrices", body = toJSON(body, auto_unbox = TRUE, null = "null"), encode = "json" ) result <- content(response, "parsed", encoding = "UTF-8") print(result) } ######################################################################################################## ######################################################################################################## #' TODO Pour l'instant on récupère la dernière extraction, à terme il faudra récupérer l'intégration SPIE #' ATTENTION problème import fichier à cause des \ User !!!!!!!!!!!!!!!!!!!!!!!!!!! get_parents_ipg <- function(){ meresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byMERE_20260106.csv", sep=''), show_col_types = FALSE) colnames(meresIPG) <- c('ANIM','NBPRODIPG') peresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byPERE_20260106.csv", sep=''), show_col_types = FALSE) colnames(peresIPG) <- c('ANIM','NBPRODIPG') parentsIPG <- rbind(meresIPG, peresIPG) }