Web サイトとの対話

{value
   let web-buffer:TextFlowBox =
       {TextFlowBox width = 5in, border-width = 1pt,
           border-color = "black", margin = 2pt
       }
   let connect-button:CommandButton =
       {CommandButton
           label = "Get the Curl home page!",
           {on Action do
               {web-buffer.clear}
               let weburl:Url = {abs-url "http://www.curl.com"}
               let webdata:#TextInputStream
               {try
                   || Add the results to the TextFlowBox
                   set webdata = {read-open weburl}
                   || Keep getting stuff until there's no more
                   {until webdata.end-of-stream? do
                       {web-buffer.add {webdata.read-one-line}}
                       {web-buffer.add {br}}
                   }

                catch http-ex:HttpException do
                   {web-buffer.add
                       {text
                           color="red", Some sort of error
                           occurred connecting to {value weburl}:
                           {italic {value http-ex.value}}
                       }
                   }
                finally {if-non-null webdata then {webdata.close}}
               }
           }
       }
   {spaced-vbox
       connect-button,
       {text Results:},
       web-buffer
   }
}

{value
    let web-buffer:TextFlowBox =
        {TextFlowBox width = 5in, border-width = 1pt,
            border-color = "black", margin = 2pt
        }
    let connect-button:CommandButton =
        {CommandButton
            label = "Get the Curl home page!",
            || when button is clicked ...
            {on Action do
                let web-url:Url = {abs-url "http://www.curl.com"}
                let http-file:HttpFile =
                    {web-url.instantiate-File} asa HttpFile
                || open the Url
                let web-stream:HttpTextInputStream =
                    {http-file.http-read-open
                        || don't redirect
                        auto-redirect? = false,
                        || return response headers even if error status
                        always-return-response-headers? = true}
                || display status
                {web-buffer.add
                    "Status: " &
                    web-stream.response-headers.status}
                || display response headers
                {for value:String key name:String in
                    web-stream.response-headers do
                    {web-buffer.add {br}}
                    {web-buffer.add
                        name &
                        {if value == "" then
                            ""
                         else
                            ": " & value}
                    }
                }
                {web-stream.close}
                web-buffer
            }
        }
    {spaced-vbox
        connect-button,
        {HBox {text Response Headers:}},
        {HBox width=5in, web-buffer}
    }
}

{HttpForm
    {url "http://www.curl.com/cgi-bin/list-parameters.pl"},
    target="_blank",
    {spaced-hbox
        {text Your name:},
        {TextField name="name"},
        {reset-button},
        {submit-button}
    }
}

|| Define an exception that the fields can throw.
{define-class public HttpFieldException {inherits Exception}
  {constructor public {default message:String}
    {construct-super message}
  }
}

{HttpForm
    {url "http://www.curl.com/cgi-bin/list-parameters.pl"},
    {spaced-vbox
        halign="right",
        {spaced-hbox
            {text Name:},
            {TextField
                name="name",
                || When user submits the form, check to ensure
                || field has content.
                {on Commit at f:TextField do
                    {if f.value.empty? then
                        {throw
                            {HttpFieldException
                                "Name field must have a value."
                            }
                        }
                    }
                }
            }
        },
        {HBox
            {reset-button},
            {Fill},
            {CommandButton
                label="Submit",
                {on Action at s:CommandButton do
                    {try
                        {s.form.submit}
                     catch e:HttpFieldException do
                        {popup-message
                            {text There is a problem with
                                the form: {value e}.
                            }
                        }
                     catch e:HttpException do
                        {popup-message
                            {text An error occurred while submitting
                                the form: {value e}
                            }
                        }
                    }
                }
            }
        }
    }
}

{HttpForm
    {url "http://www.curl.com/cgi-bin/list-parameters.pl"},
    margin=4pt,
    {spaced-hbox
        {text Search:},
        {TextField
            name="search-term",
            {on Action at t:TextField do
                {t.form.submit}
            }
        }
    }
}

|| Holds the URL of the file the user wants to upload
{let my-file-url:#Url}
{let submit-button:CommandButton =
    {CommandButton
        enabled?=false,
        label="Submit",
        {on Action do
            || Add the file to the form
            {submit-button.form.add-file
                "uploaded-file",
                || will not be null when Submit button is enabled
                {non-null my-file-url}
            }
            || Submit the request
            {submit-button.form.submit}
            set submit-button.enabled? = false
            set submit-button.label = "Submit"
            {submit-button.form.reset}
        }
    }
}

{HttpForm
    {url "http://www.curl.com/cgi-bin/file-upload.pl"},
    margin=6pt,
    method=HttpRequestMethod.post,
    encoding=HttpFormData.multipart-mime-type,
    {spaced-hbox
        {CommandButton
            border-style=BorderStyle.raised,
            label="Choose File",
            || Ask the user for a file.
            {on Action do
                set my-file-url =
                    {choose-file title="Select a file to upload"}
                {if-non-null my-file-url then
                    || Display the name of the selected file
                    set submit-button.label = "Submit " & my-file-url.name
                    set submit-button.enabled? = true
                }
            }
        },
        submit-button
    }
}

|| Get the cookies for this applet's URL.
{let cookies:{Array-of HttpCookie} =
    {get-http-cookies
        {get-the-applet}.url
    }
}

|| Table to list cookies in
{let cookie-list:Visual =
    {Table
        {row-prototype
            font-weight="bold",
            "Name",
            "Value",
            "Expiration"
        }
    }
}

{if cookies.empty? then
    || There were no cookies
    {set cookie-list = {text No cookie for you!}}
 else
    {for cookie:HttpCookie in cookies do
        {cookie-list.add
            {row-prototype
                cookie.name,
                cookie.value,
                || Expires and other fields may return null,
                || If expires means null, then this is a cookie
                || that only lasts until the current session
                || ends (i.e. user closes the browser).
                {if-non-null cookie.expires then
                    cookie.expires
                 else
                    {text Session-only}
                }
            }
        }
    }
}

{value cookie-list}

{let cookie-name:TextField = {TextField}}
{let cookie-value:TextField = {TextField}}

{let change-it:CommandButton =
    {CommandButton
        label="Set cookie",
        {on Action do
            {if not (cookie-name.value.empty? or cookie-value.value.empty?)
             then
                || Construct the cookie
                let cookie:HttpCookie =
                    {HttpCookie
                        cookie-name.value,
                        cookie-value.value
                    }
                || Set the cookie so that the browser will
                || submit it to the server for any requests
                || under the applet's directory.
                {set-insecure-http-cookie
                    {get-the-applet}.url,
                    cookie
                }
                || Now load the applet that displays the
                || cookies.
                {{get-the-applet}.browse-url
                    {url "get-cookies.curl"}
                }
             else
                {popup-message
                    {text You must provide both a cookie name
                        and a value.}
                }
            }
        }
    }
}

|| Lay out the controls.
{VBox
    halign="right",
    {spaced-hbox {text Cookie name:}, cookie-name},
    {spaced-hbox {text Cookie value:}, cookie-value},
    {spaced-hbox {Fill},change-it}
}