Wie schicke ich ein Formular, das JavaScript mit httr oder rvest zu behandeln scheint?

Question

Ich versuche, eine Website programmatisch zu suchen, aber die Funktion zum Senden von Schaltflächen scheint hauptsächlich von JavaScript angetrieben zu werden. Ich weiß nicht, wie das funktioniert, aber ich könnte mich irren.

Hier ist der Code ich benutze:

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 

Der HTML-Code für die Schaltfläche wie folgt aussieht:

<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;"> 

Gegeben ist das onclick Attribut, meine ungebildet Annahme, dass die Verwendung von JavaScript ist, was meinen Ansatz stört. Aber ich verstehe nicht, wie das alles funktioniert, also könnte ich mich irren.

Wie erreiche ich mein Ziel, wenn überhaupt, rvest oder httr, aber nicht RSelenium? Wenn das in Python möglich ist, werde ich das auch akzeptieren.

Answer 1

Wir müssen zuerst die ursprüngliche Suchseite zu erhalten, da dies eine Sharepoint-Website (oder verhält sich wie ein), und wir brauchen einige versteckte Formularfelder später zu verwenden:

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" 

Jetzt müssen wir handeln wie die Form und die Verwendung HTTP POST es einreichen:

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 

Wir werden diese Hilfsfunktion in einer Minute müssen:

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

Nun

, müssen wir den HTML-Code aus der Ergebnisseite:

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

Leider ist der "Tisch" ist wirklich ein Satz von <div> s. Aber es ist programmatisch generiert und ziemlich einheitlich. Wir wollen nicht viel geben, so lassen Sie uns zuerst die Spaltennamen erhalten wir später verwenden werden:

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"  

Die Seite ist ziemlich nett, dass es Menschen mit Behinderungen bietet Platz von Bildschirmlesehinweise bereitstellt. Leider bringt dies ein Kratzen beim Scraping mit sich, da wir entweder ausführlich sein müssen, um die Tags mit Werten auszurichten, oder später Text bereinigen. Zum Glück hat die xml2 jetzt die Möglichkeit, Knoten entfernen:

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

Und kurz und bündig, sie in einem Datenrahmen zu erhalten:

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

Wir können jetzt alle Täter Aufzeichnungen <div> „Reihen“ sammeln

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, ... 

ich hatte gehofft, die type_convert wld besser Transformationen bieten, besonders für die Datumsspalte (n), aber es hat nicht und eli wahrscheinlich sein kann miniert.

Jetzt müssen Sie mit der Ergebnisseite mehr arbeiten, da die Ergebnisse paginiert sind.Zum Glück kennen Sie die Seite Info:

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

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

Sie werden die „versteckten“ Tanz zu tun haben wieder:

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

(folgen oben ref für das, was damit zu tun) und eine neue rejigger POST Aufruf, der nur diese ausgeblendeten Felder und ein weiteres Formularelement enthält: btnNext = 'Next'. Sie müssen dies über alle einzelnen Seiten in der paginierten Ergebnismenge wiederholen, dann schließlich bind_rows() alles.

Ich möchte hinzufügen, dass, wenn Sie den Paginierungsworkflow herausfinden, mit einem frischen, leeren Suchseitengriff beginnen. Der Sharepoint-Server scheint mit einem sehr kleinen Viewstate-Sitzungs-Cache-Timeout konfiguriert zu sein, und der Code wird unterbrochen, wenn Sie zwischen den Iterationen zu lange warten.

UPDATE

ich irgendwie sicherstellen wollte, dass letzte Stück der Beratung gearbeitet, so ist es dies:

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 

} 

Hoffentlich können Sie folgen zusammen, aber das SHD alle Seiten für Sie erhalten für ein gegebener Suchbegriff.