helm/DEVEL/pxp/pxp/examples/simple_transformation/sort.ml

   1 (* $Id$
   2  * ----------------------------------------------------------------------
   3  *
   4  *)
   5
   6 (* Read a record-list, sort it, and print it as XML *)
   7 open Pxp_types;;
   8 open Pxp_document;;
   9 open Pxp_yacc;;
  10
  11 let sort by tree =
  12   map_tree
  13     ~pre:
  14       (fun n -> n # orphaned_flat_clone)
  15     ~post:
  16       (fun n ->
  17          match n # node_type with
  18              T_element "record-list" ->
  19                let l = n # sub_nodes in
  20                let l' = List.sort
  21                           (fun a b ->
  22                              let a_string =
  23                                try (find_element by a) # data
  24                                with Not_found -> "" in
  25                              let b_string =
  26                                try (find_element by b) # data
  27                                with Not_found -> "" in
  28                              Pervasives.compare a_string b_string)
  29                           l in
  30                n # set_nodes l';
  31                n
  32            | _ ->
  33                n)
  34     tree
  35 ;;
  36
  37
  38 let main() =
  39   let criterion = ref "last-name" in
  40   Arg.parse
  41       [ "-by", Arg.String (fun s -> criterion := s),
  42             " (last-name|first-name|phone)";
  43       ]
  44       (fun _ -> raise (Arg.Bad "Bad usage"))
  45       "usage: sort [ options ]";
  46   if not(List.mem !criterion ["last-name"; "first-name"; "phone"]) then (
  47     prerr_endline ("Unknown criterion: " ^ !criterion);
  48     exit 1
  49   );
  50   try
  51     let dtd = parse_dtd_entity default_config (from_file "record.dtd") in
  52     let tree =
  53       parse_content_entity default_config (from_channel stdin) dtd default_spec
  54     in
  55     print_endline "<?xml encoding='ISO-8859-1'?>";
  56     (sort !criterion tree) # write (Out_channel stdout) `Enc_iso88591
  57   with
  58       x ->
  59         prerr_endline(string_of_exn x);
  60         exit 1
  61 ;;
  62
  63
  64 main();;
  65
  66 (* ======================================================================
  67  * History:
  68  *
  69  * $Log$
  70  * Revision 1.1  2000/11/17 09:57:32  lpadovan
  71  * Initial revision
  72  *
  73  * Revision 1.3  2000/08/30 16:05:44  gerd
  74  *      Minor update
  75  *
  76  * Revision 1.2  2000/08/24 09:40:11  gerd
  77  *      Allow that columns are missing.
  78  *
  79  * Revision 1.1  2000/08/22 21:57:44  gerd
  80  *      Initial revision.
  81  *
  82  *
  83  *)