examples/loadpage.ml

   1 (* Example program which uses LWP::UserAgent and HTML::TreeBuilder to
   2  * download an HTTP page and parse it.
   3  * Copyright (C) 2003 Merjis Ltd.
   4  * $Id: loadpage.ml,v 1.4 2003-10-16 11:03:52 rich Exp $
   5  *)
   6
   7 open Printf
   8
   9 open Pl_LWP_UserAgent
  10 open Pl_HTTP_Request
  11 open Pl_HTML_TreeBuilder
  12 open Pl_HTML_Element
  13
  14 let () =
  15   let site =
  16     if Array.length Sys.argv >= 2 then
  17       Sys.argv.(1)
  18     else
  19       "http://www.merjis.com/" in
  20
  21   (* Create the UserAgent object. *)
  22   let ua = Pl_LWP_UserAgent.new_ ~env_proxy:true () in
  23
  24   (* Fetch the page. *)
  25   let req = Pl_HTTP_Request.new_ "GET" ~uri:site () in
  26   let res = ua#request req in
  27
  28   if not res#is_success then
  29     failwith ("Error while fetching " ^ site ^ ": " ^ res#status_line);
  30
  31   (* Extract the content of the page. *)
  32   let content = res#content in
  33
  34   (* Parse it using HTML::TreeBuilder. *)
  35   let tree = Pl_HTML_TreeBuilder.new_from_content content in
  36
  37   (* Turn the tree into an HTML::Element. *)
  38   let tree = tree#elementify in
  39
  40   (* Print out the resulting tree. *)
  41   let rec print root =
  42     let tag = root#tag in
  43     let attrs = root#all_external_attr in
  44     let subnodes = root#content_list in
  45
  46     printf "Start tag: %s\n" tag;
  47     List.iter (fun (name, value) ->
  48                  printf "\tAttr: %s=\"%s\"\n" name value) attrs;
  49
  50     List.iter (fun node ->
  51                  match node with
  52                      Element node -> print node
  53                    | String str ->
  54                        printf "String: %s\n" str) subnodes;
  55     printf "End tag: %s\n" tag
  56   in
  57   print tree;
  58
  59   (* Destroy the Perl interpreter. *)
  60   Perl.destroy (Perl.current_interpreter ());
  61
  62   (* Perform a full collection - good way to find GC/allocation bugs. *)
  63   Gc.full_major ()