Comment soumettre un formulaire qui semble être géré par JavaScript en utilisant httr ou rvest?

Question

J'essaye de rechercher par programme un site Web, mais la fonctionnalité de bouton de soumission semble être principalement alimentée par JavaScript. Je ne suis pas trop familier avec la façon dont cela fonctionne, donc je peux me tromper.

Voici le code que je utilise:

library(rvest) 

BASE_URL = 'https://mdocweb.state.mi.us/otis2/otis2.aspx' 
PARAMS = list(txtboxLName='Smith', 
       drpdwnGender='Either', 
       drpdwnRace='All', 
       drpdwnStatus='All', 
       submit='btnSearch') 

# rvest approach 
s = html_session(BASE_URL) 
form = html_form(s)[[1]] 
form = set_values(form, PARAMS) 
resp = submit_form(s, form, submit='btnSearch') # This gives an error 

# httr approach 
resp = httr::POST(BASE_URL, body=PARAMS, encode='form') 
html = httr::content(resp) # This just returns that same page I was on 

Le code HTML du bouton ressemble à ceci:

<input type="submit" name="btnSearch" value="Search" onclick="javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions(&quot;btnSearch&quot;, &quot;&quot;, true, &quot;&quot;, &quot;&quot;, false, false))" language="javascript" id="btnSearch" style="width:100px;"> 

Compte tenu de l'attribut onclick, mon hypothèse est sans instruction que l'utilisation de JavaScript est ce qui interfère avec mon approche. Mais encore une fois, je ne comprends pas complètement comment tout cela fonctionne, donc je peux me tromper.

De toute façon, comment puis-je atteindre mon objectif, le cas échéant, en utilisant rvest ou httr, mais pas RSelenium? Aussi, si cela est réalisable en Python, je l'accepterai aussi.

Answer 1

Nous devons d'abord obtenir la page de recherche originale puisque c'est un site sharepoint (ou agit comme un) et nous avons besoin de champs de formulaire cachés à utiliser plus tard:

library(httr) 
library(rvest) 
library(tidyverse) 

pre_pg <- read_html("https://mdocweb.state.mi.us/otis2/otis2.aspx") 

setNames(
    html_nodes(pre_pg, "input[type='hidden']") %>% html_attr("value"), 
    html_nodes(pre_pg, "input[type='hidden']") %>% html_attr("name") 
) -> hidden 

str(hidden) 
## Named chr [1:3] "x62pLbphYWUDXsdoNdBBNrxqyHHI+K06BzjFwdP3Uooafgey2uG1gLWxzh07djRxiQR724uplZFAI8klbq6HCSkmrp8jP15EMwvkDM/biUEuQrf"| __truncated__ ... 
## - attr(*, "names")= chr [1:3] "__VIEWSTATE" "__VIEWSTATEGENERATOR" "__EVENTVALIDATION" 

Maintenant, nous devons agir comme la forme et l'utilisation HTTP POST de le soumettre:

POST(
    url = "https://mdocweb.state.mi.us/otis2/otis2.aspx", 
    add_headers(
    Origin = "https://mdocweb.state.mi.us", 
    `User-Agent` = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/62.0.3202.52 Safari/537.36", 
    Referer = "https://mdocweb.state.mi.us/otis2/otis2.aspx" 
), 
    body = list(
    `__EVENTTARGET` = "", 
    `__EVENTARGUMENT` = "", 
    `__VIEWSTATE` = hidden["__VIEWSTATE"], 
    `__VIEWSTATEGENERATOR` = hidden["__VIEWSTATEGENERATOR"], 
    `__EVENTVALIDATION` = hidden["__EVENTVALIDATION"], 
    txtboxLName = "Smith", 
    txtboxFName = "", 
    txtboxMDOCNum = "", 
    drpdwnGender = "Either", 
    drpdwnRace = "All", 
    txtboxAge = "", 
    drpdwnStatus = "All", 
    txtboxMarks = "", 
    btnSearch = "Search" 
), 
    encode = "form" 
) -> res 

Nous allons avoir besoin de cette fonction d'assistance dans une minute:

mcga <- function(x) { 
    x <- tolower(x) 
    x <- gsub("[[:punct:][:space:]]+", "_", x) 
    x <- gsub("_+", "_", x) 
    x <- gsub("(^_|_$)", "", x) 
    make.unique(x, sep = "_") 
} 

Maintenant, nous avons besoin le code HTML de la page de résultats:

pg <- content(res, as="parsed") 

Malheureusement, la "table" est vraiment un ensemble de <div> s. Mais, il est généré par programme et assez uniforme. Nous ne voulons pas taper si bien nous allons d'abord obtenir les noms de colonnes que nous utiliserons plus tard:

col_names <- html_nodes(pg, "a.headings") %>% html_text(trim=TRUE) %>% mcga() 
## [1] "offender_number"    "last_name"      "first_name"      
## [4] "date_of_birth"     "sex"       "race"       
## [7] "mcl_number"      "location"      "status"       
## [10] "parole_board_jurisdiction_date" "maximum_date"     "date_paroled"  

Le site est assez agréable en ce qu'il accueille des gens handicapés en fournissant des conseils de lecture d'écran. Malheureusement, cela met un point d'achoppement car nous devions être verbeux en ciblant les balises avec des valeurs ou en nettoyant le texte plus tard. Heureusement, le xml2 a maintenant la possibilité de supprimer des nœuds:

xml_find_all(pg, ".//div[@class='screenReaderOnly']") %>% xml_remove() 
xml_find_all(pg, ".//span[@class='visible-phone']") %>% xml_remove() 

Nous pouvons maintenant rassembler tous les délinquants enregistrements <div> « lignes »:

records <- html_nodes(pg, "div.offenderRow") 

Et les obtenir succinctement dans une trame de données:

map(sprintf(".//div[@class='span1 searchCol%s']", 1:12), ~{ 
    html_nodes(records, xpath=.x) %>% html_text(trim=TRUE) 
}) %>% 
    set_names(col_names) %>% 
    bind_cols() %>% 
    readr::type_convert() -> xdf 

xdf 
## # A tibble: 25 x 12 
## offender_number last_name first_name date_of_birth sex race mcl_number  location status 
##    <int>  <chr>  <chr>   <chr> <chr> <chr>  <chr>   <chr> <chr> 
## 1   544429  SMITH  AARICK 12/03/1967  M White 333.74012D3   Gladwin Parole 
## 2   210262  SMITH  AARON 05/27/1972  M Black  <NA>   <NA> Dischrg 
## 3   372965  SMITH  AARON 09/16/1973  M White  <NA>   <NA> Dischrg 
## 4   413411  SMITH  AARON 07/13/1973  M Black  <NA>   <NA> Dischrg 
## 5   618210  SMITH  AARON 10/12/1984  M Black  <NA>   <NA> Dischrg 
## 6   675823  SMITH  AARON 05/19/1989  M Black 333.74032A5 Det Lahser Prob Prob 
## 7   759548  SMITH  AARON 06/19/1990  M Black  <NA>   <NA> Dischrg 
## 8   763189  SMITH  AARON 07/15/1976  M White 333.74032A5 Mt. Pleasant Prob 
## 9   854557  SMITH  AARON 12/27/1973  M White  <NA>   <NA> Dischrg 
## 10   856804  SMITH  AARON 02/24/1989  M White 750.110A2  Harrison CF Prison 
## # ... with 15 more rows, and 3 more variables: parole_board_jurisdiction_date <chr>, maximum_date <chr>, 
## # date_paroled <chr> 

glimpse(xdf) 
## Observations: 25 
## Variables: 12 
## $ offender_number    <int> 544429, 210262, 372965, 413411, 618210, 675823, 759548, 763189, 854557, 85... 
## $ last_name      <chr> "SMITH", "SMITH", "SMITH", "SMITH", "SMITH", "SMITH", "SMITH", "SMITH", "S... 
## $ first_name      <chr> "AARICK", "AARON", "AARON", "AARON", "AARON", "AARON", "AARON", "AARON", "... 
## $ date_of_birth     <chr> "12/03/1967", "05/27/1972", "09/16/1973", "07/13/1973", "10/12/1984", "05/... 
## $ sex       <chr> "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M",... 
## $ race       <chr> "White", "Black", "White", "Black", "Black", "Black", "Black", "White", "W... 
## $ mcl_number      <chr> "333.74012D3", NA, NA, NA, NA, "333.74032A5", NA, "333.74032A5", NA, "750.... 
## $ location      <chr> "Gladwin", NA, NA, NA, NA, "Det Lahser Prob", NA, "Mt. Pleasant", NA, "Har... 
## $ status       <chr> "Parole", "Dischrg", "Dischrg", "Dischrg", "Dischrg", "Prob", "Dischrg", "... 
## $ parole_board_jurisdiction_date <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, "11/28/2024", "03/25/2016", NA, NA, NA... 
## $ maximum_date     <chr> NA, "09/03/2015", "06/29/2016", "10/02/2017", "05/19/2017", "07/18/2019", ... 
## $ date_paroled     <chr> "11/15/2016", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ... 

je l'avais espéré le type_convert wld fournir de meilleurs transforme, surtout pour la colonne date (s) mais il n'a pas et ne peut probablement eli miné.

Maintenant, vous aurez besoin de travailler encore plus sur la page de résultats puisque les résultats sont paginés.Heureusement, vous connaissez la page info:

xml_integer(html_nodes(pg, "span#lblPgCurrent")) 
## [1] 1 

xml_integer(html_nodes(pg, "span#lblTotalPgs")) 
## [1] 101 

Vous aurez à faire la danse « cachée » à nouveau:

html_nodes(pg, "input[type='hidden']") 

(suivre ci-dessus ref pour quoi faire avec cela) et rejigger une nouvelle POST appel qui a seulement ces champs cachés et un autre élément de formulaire: btnNext = 'Next'. Vous aurez besoin de répéter cela sur toutes les pages individuelles dans le jeu de résultats paginés puis finalement bind_rows() tout.

Je dois ajouter que lorsque vous définissez le flux de travail de pagination, commencez par une capture de page de recherche vide. Le serveur sharepoint semble être configuré avec un délai d'expiration de cache de session viewstate assez petit et le code va se casser si vous attendez trop longtemps entre les itérations.

MISE À JOUR

Je voulais un peu à faire en sorte que dernier conseil a travaillé si il y a ceci:

library(httr) 
library(rvest) 
library(tidyverse) 

mcga <- function(x) { 
    x <- tolower(x) 
    x <- gsub("[[:punct:][:space:]]+", "_", x) 
    x <- gsub("_+", "_", x) 
    x <- gsub("(^_|_$)", "", x) 
    make.unique(x, sep = "_") 
} 

start_search <- function(last_name) { 

    pre_pg <- read_html("https://mdocweb.state.mi.us/otis2/otis2.aspx") 

    setNames(
    html_nodes(pre_pg, "input[type='hidden']") %>% html_attr("value"), 
    html_nodes(pre_pg, "input[type='hidden']") %>% html_attr("name") 
) -> hidden 

    POST(
    url = "https://mdocweb.state.mi.us/otis2/otis2.aspx", 
    add_headers(
     Origin = "https://mdocweb.state.mi.us", 
     `User-Agent` = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/62.0.3202.52 Safari/537.36", 
     Referer = "https://mdocweb.state.mi.us/otis2/otis2.aspx" 
    ), 
    body = list(
     `__EVENTTARGET` = "", 
     `__EVENTARGUMENT` = "", 
     `__VIEWSTATE` = hidden["__VIEWSTATE"], 
     `__VIEWSTATEGENERATOR` = hidden["__VIEWSTATEGENERATOR"], 
     `__EVENTVALIDATION` = hidden["__EVENTVALIDATION"], 
     txtboxLName = last_name, 
     txtboxFName = "", 
     txtboxMDOCNum = "", 
     drpdwnGender = "Either", 
     drpdwnRace = "All", 
     txtboxAge = "", 
     drpdwnStatus = "All", 
     txtboxMarks = "", 
     btnSearch = "Search" 
    ), 
    encode = "form" 
) -> res 

    content(res, as="parsed") 

} 

extract_results <- function(results_pg) { 

    col_names <- html_nodes(results_pg, "a.headings") %>% html_text(trim=TRUE) %>% mcga() 

    xml_find_all(results_pg, ".//div[@class='screenReaderOnly']") %>% xml_remove() 

    xml_find_all(results_pg, ".//span[@class='visible-phone']") %>% xml_remove() 

    records <- html_nodes(results_pg, "div.offenderRow") 

    map(sprintf(".//div[@class='span1 searchCol%s']", 1:12), ~{ 
    html_nodes(records, xpath=.x) %>% html_text(trim=TRUE) 
    }) %>% 
    set_names(col_names) %>% 
    bind_cols() 

} 

current_page_number <- function(results_pg) { 
    xml_integer(html_nodes(results_pg, "span#lblPgCurrent")) 
} 

last_page_number <- function(results_pg) { 
    xml_integer(html_nodes(results_pg, "span#lblTotalPgs")) 
} 

scrape_status <- function(results_pg) { 

    cur <- current_page_number(results_pg) 
    tot <- last_page_number(results_pg) 

    message(sprintf("%s of %s", cur, tot)) 

} 

next_page <- function(results_pg) { 

    cur <- current_page_number(results_pg) 
    tot <- last_page_number(results_pg) 

    if (cur == tot) return(NULL) 

    setNames(
    html_nodes(results_pg, "input[type='hidden']") %>% html_attr("value"), 
    html_nodes(results_pg, "input[type='hidden']") %>% html_attr("name") 
) -> hidden 

    POST(
    url = "https://mdocweb.state.mi.us/otis2/otis2.aspx", 
    add_headers(
     Origin = "https://mdocweb.state.mi.us", 
     `User-Agent` = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/62.0.3202.52 Safari/537.36", 
     Referer = "https://mdocweb.state.mi.us/otis2/otis2.aspx" 
    ), 
    body = list(
     `__EVENTTARGET` = hidden["__EVENTTARGET"], 
     `__EVENTARGUMENT` = hidden["__EVENTARGUMENT"], 
     `__VIEWSTATE` = hidden["__VIEWSTATE"], 
     `__VIEWSTATEGENERATOR` = hidden["__VIEWSTATEGENERATOR"], 
     `__EVENTVALIDATION` = hidden["__EVENTVALIDATION"], 
     btnNext = 'Next' 
    ), 
    encode = "form" 
) -> res 

    content(res, as="parsed") 

} 

curr_pg <- start_search("smith") 
results_df <- extract_results(curr_pg) 

pb <- progress_estimated(last_page_number(curr_pg)-1) 

repeat{ 

    scrape_status(curr_pg) # optional esp since we have a progress bar 

    pb$tick()$print() 

    curr_pg <- next_page(curr_pg) 

    if (is.null(curr_pg)) break 

    results_df <- bind_rows(results_df, extract_results(next_pg)) 

    Sys.sleep(5) # be kind 

} 

Espérons que vous pouvez suivre, mais SHD obtenir toutes les pages pour vous pour un terme de recherche donné.