1test_that("can find from from doc, nodes, and node", { 2 html <- minimal_html(' 3 <form><input name="x" type="text"></form> 4 <form><input name="x" type="text"></form> 5 ') 6 7 forms <- html_form(html) 8 expect_type(forms, "list") 9 expect_length(forms, 2) 10 11 forms <- html_form(html_elements(html, "form")) 12 expect_type(forms, "list") 13 expect_length(forms, 2) 14 15 form <- html_form(html_element(html, "form")) 16 expect_s3_class(form, "rvest_form") 17}) 18 19test_that("has useful print method", { 20 html <- minimal_html(' 21 <form id="test" method="post" action="/test-path"> 22 <select name="select" size="1"></select> 23 <input type="text" name="name" value="Hadley" /> 24 <input type="password" name="name" value="Hadley" /> 25 <button type="submit" name="clickMe">Click me</button> 26 <textarea name="address">ABCDEF</textarea> 27 </form> 28 ') 29 expect_snapshot(html_form(html, base_url = "http://google.com")[[1]]) 30 expect_snapshot(html_form(html)[[1]]$fields[[2]]) 31}) 32 33 34test_that("select options are named character vector", { 35 select <- minimal_html("select parsing", ' 36 <form> 37 <select name="x"> 38 <option value="1">a</option> 39 <option value="2">b</option> 40 </select> 41 </form> 42 ') 43 44 form <- select %>% html_element("form") %>% html_form() 45 expect_equal(form$fields[[1]]$options, c(a = "1", b = "2")) 46}) 47 48test_that("select values are inherited from names", { 49 page <- minimal_html("optional values", ' 50 <select name="b" id="a"> 51 <option value="1">x</option> 52 <option>y</option> 53 </select> 54 ') 55 56 opts <- page %>% html_element('select') %>% parse_select() 57 expect_equal(opts$options, c(x = "1", y = "y")) 58}) 59 60test_that("parse_fields gets the button", { 61 select <- minimal_html("button test", ' 62 <form> 63 <button type="submit">Click me</button> 64 </form> 65 ') 66 67 form <- select %>% html_element("form") %>% html_form() 68 expect_equal(form$fields[[1]]$type, "button") 69}) 70 71test_that("handles different encoding types", { 72 expect_equal(convert_enctype(NULL), "form") 73 expect_equal(convert_enctype("application/x-www-form-urlencoded"), "form") 74 expect_equal(convert_enctype("multipart/form-data"), "multipart") 75 76 expect_snapshot(convert_enctype("unknown")) 77}) 78 79# set -------------------------------------------------------------- 80 81test_that("can set values of inputs", { 82 html <- minimal_html(' 83 <form id="test" method="post" action="/test-path"> 84 <input type="text" name="text" /> 85 <input type="hidden" name="hidden" /> 86 </form> 87 ') 88 form <- html_form(html)[[1]] 89 90 form <- html_form_set(form, text = "abc") 91 expect_equal(form$fields$text$value, "abc") 92 93 # warns that setting hidden field 94 expect_snapshot(form <- html_form_set(form, hidden = "abc")) 95 expect_equal(form$fields$hidden$value, "abc") 96}) 97 98test_that("has informative errors", { 99 html <- minimal_html(' 100 <form id="test" method="post" action="/test-path"> 101 <input type="submit" name="text" /> 102 </form> 103 ') 104 105 form <- html_form(html)[[1]] 106 expect_snapshot(html_form_set(form, text = "x"), error = TRUE) 107 expect_snapshot(html_form_set(form, missing = "x"), error = TRUE) 108}) 109 110# submit ------------------------------------------------------------------ 111 112test_that("works as expected in simple case", { 113 html <- minimal_html(' 114 <form method="post" action="/test-path"> 115 <input name="x" value="1"> 116 <button type="submit" name="clickMe">Click me</button> 117 </form> 118 ') 119 form <- html_form(html, base_url = "http://here.com")[[1]] 120 121 sub <- submission_build(form, "clickMe") 122 expect_equal(sub$method, "POST") 123 expect_equal(sub$action, "http://here.com/test-path") 124 expect_equal(sub$values, list(x = "1")) 125}) 126 127 128test_that("useful feedback on invalid forms", { 129 html <- minimal_html("<form></form>") 130 form <- html_form(html)[[1]] 131 expect_snapshot(submission_build(form, NULL), error = TRUE) 132 133 html <- minimal_html("<form action='/' method='foo'></form>") 134 form <- html_form(html)[[1]] 135 expect_snapshot(x <- submission_build(form, NULL)) 136}) 137 138test_that("can handle multiple values", { 139 html <- minimal_html(' 140 <form method="post" action="/"> 141 <input type="text" name="x"> 142 <input type="text" name="y"> 143 </form> 144 ') 145 form <- html_form(html)[[1]] 146 form <- html_form_set(form, x = c("1", "2", "3"), y = character()) 147 148 expect_equal( 149 submission_build_values(form), 150 list(x = "1", x = "2", x = "3") 151 ) 152}) 153 154test_that("handles multiple buttons", { 155 html <- minimal_html(' 156 <form action="/"> 157 <button type="submit" name="one" value="1">Click me</button> 158 <button type="submit" name="two" value="2">Click me</button> 159 </form> 160 ') 161 form <- html_form(html)[[1]] 162 163 # Messages when picking automatically 164 expect_snapshot(vals <- submission_build_values(form, NULL)) 165 expect_equal(vals, list(one = "1")) 166 167 expect_equal(submission_build_values(form, "two"), list(two = "2")) 168 expect_equal(submission_build_values(form, 2L), list(two = "2")) 169 170 # Useful failure messages 171 expect_snapshot(submission_build_values(form, 3L), error = TRUE) 172 expect_snapshot(submission_build_values(form, "three"), error = TRUE) 173 expect_snapshot(submission_build_values(form, TRUE), error = TRUE) 174}) 175 176test_that("handles no buttons", { 177 html <- minimal_html(' 178 <form action="/"> 179 <input type="text", name="x" value="1"> 180 </form> 181 ') 182 form <- html_form(html)[[1]] 183 184 expect_equal( 185 submission_build_values(form), 186 list(x = "1") 187 ) 188}) 189 190test_that("can submit using three primary techniques", { 191 app <- webfakes::local_app_process(app_request()) 192 193 html <- minimal_html(' 194 <form action="/"> 195 <input type="text", name="x" value="1"> 196 <input type="text", name="x" value="2"> 197 <input type="text", name="y" value="3"> 198 </form> 199 ') 200 form <- html_form(html, base_url = app$url())[[1]] 201 202 expect_snapshot({ 203 show_response(html_form_submit(form)) 204 205 form$method <- "POST" 206 show_response(html_form_submit(form)) 207 208 form$enctype <- "multipart" 209 show_response(html_form_submit(form)) 210 }) 211}) 212