#' 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)) if(nrow(active_by_chep$vaches) == 0 ) return(active_by_chep) donneuses <- active_by_chep$donneuses nomsparents <- active_by_chep$nomsparents active_by_chep$donneuses <- NULL active_by_chep$nomsparents <- 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 active_by_chep$nomsparents <- nomsparents 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) ) } #' Suppression des données du jour #' @param cheptel Numéro du cheptel #' @param table Nom de la table dont on veut supprimer les données : VACHES, CAMPAGNES, TAUREAUX, LIGNEES #' @return Nombre de lignes supprimées delete_data_today <- function(cheptel, table){ url_delete_data <- paste0(server_path,"webresources/ecow/delete/",cheptel,"/",table) delete_data <- http_get( url = url_delete_data) } #' 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)) } #' Récupère le nombre de veaux total par parents à partir d'une extraction excel complétée par les données SPIE #' Le nombre renvoyé est le nombre total tous cheptels confondus, sans détail sur les veaux get_parents_ipg <- function(){ # Extraction du fichier excel contenant les données de la table bovide du SIG jusqu'au 06/01/2026 meresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byMERE_20260106.csv", sep=''), show_col_types = FALSE) colnames(meresIPG) <- c('ANIM','NBPRODSIG') # Extraction SPIE pour compléter à partir du 03/01/2026 (choix date pour essayer de limiter les doublons et manquement) url_meres_spie <- paste0(server_path, "webresources/spie/nbprodbymeresince2026/") meres_spie_brut <- http_get(url = paste0(url_meres_spie, num_cheptel)) meres_spie <- as.data.frame(meres_spie_brut, stringsAsFactors = FALSE) colnames(meres_spie) <- c('ANIM','NBPRODSPIE') meres_spie$NBPRODSPIE <- as.numeric(meres_spie$NBPRODSPIE) groupe_meres <- full_join(meres_spie, meresIPG, by = "ANIM") %>% mutate(NBPRODIPG = coalesce(NBPRODSPIE, 0) + coalesce(NBPRODSIG, 0)) %>% select(ANIM, NBPRODIPG) # Extraction excel pères peresIPG <- read_csv(paste(rep_imp, "nb_prod_IPG_byPERE_20260106.csv", sep=''), show_col_types = FALSE) colnames(peresIPG) <- c('ANIM','NBPRODSIG') # Extraction SPIE pères url_peres_spie <- paste0(server_path, "webresources/spie/nbprodbyperesince2026/") peres_spie_brut <- http_get(url = paste0(url_peres_spie, num_cheptel)) peres_spie <- as.data.frame(peres_spie_brut, stringsAsFactors = FALSE) colnames(peres_spie) <- c('ANIM','NBPRODSPIE') peres_spie$NBPRODSPIE <- as.numeric(peres_spie$NBPRODSPIE) groupe_peres <- full_join(peres_spie, peresIPG, by = "ANIM") %>% mutate(NBPRODIPG = coalesce(NBPRODSPIE, 0) + coalesce(NBPRODSIG, 0)) %>% select(ANIM, NBPRODIPG) parentsIPG <- rbind(groupe_meres, groupe_peres) }