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