]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/DEVEL/pxp/pxp/examples/simple_transformation/sort.ml
Initial revision
[helm.git] / helm / DEVEL / pxp / pxp / examples / simple_transformation / sort.ml
diff --git a/helm/DEVEL/pxp/pxp/examples/simple_transformation/sort.ml b/helm/DEVEL/pxp/pxp/examples/simple_transformation/sort.ml
new file mode 100644 (file)
index 0000000..297730f
--- /dev/null
@@ -0,0 +1,83 @@
+(* $Id$
+ * ----------------------------------------------------------------------
+ *
+ *)
+
+(* Read a record-list, sort it, and print it as XML *)
+open Pxp_types;;
+open Pxp_document;;
+open Pxp_yacc;;
+
+let sort by tree =
+  map_tree
+    ~pre:
+      (fun n -> n # orphaned_flat_clone)
+    ~post:
+      (fun n ->
+        match n # node_type with
+            T_element "record-list" ->
+              let l = n # sub_nodes in
+              let l' = List.sort
+                         (fun a b ->
+                            let a_string = 
+                              try (find_element by a) # data 
+                              with Not_found -> "" in
+                            let b_string = 
+                              try (find_element by b) # data 
+                              with Not_found -> "" in
+                            Pervasives.compare a_string b_string)
+                         l in
+              n # set_nodes l';
+              n
+          | _ ->
+              n)
+    tree
+;;
+
+
+let main() =
+  let criterion = ref "last-name" in
+  Arg.parse
+      [ "-by", Arg.String (fun s -> criterion := s),
+           " (last-name|first-name|phone)";
+      ]
+      (fun _ -> raise (Arg.Bad "Bad usage"))
+      "usage: sort [ options ]";
+  if not(List.mem !criterion ["last-name"; "first-name"; "phone"]) then (
+    prerr_endline ("Unknown criterion: " ^ !criterion);
+    exit 1
+  );
+  try
+    let dtd = parse_dtd_entity default_config (from_file "record.dtd") in
+    let tree = 
+      parse_content_entity default_config (from_channel stdin) dtd default_spec
+    in
+    print_endline "<?xml encoding='ISO-8859-1'?>";
+    (sort !criterion tree) # write (Out_channel stdout) `Enc_iso88591
+  with
+      x ->
+       prerr_endline(string_of_exn x);
+       exit 1
+;;
+
+
+main();;
+
+(* ======================================================================
+ * History:
+ * 
+ * $Log$
+ * Revision 1.1  2000/11/17 09:57:32  lpadovan
+ * Initial revision
+ *
+ * Revision 1.3  2000/08/30 16:05:44  gerd
+ *     Minor update
+ *
+ * Revision 1.2  2000/08/24 09:40:11  gerd
+ *     Allow that columns are missing.
+ *
+ * Revision 1.1  2000/08/22 21:57:44  gerd
+ *     Initial revision.
+ *
+ * 
+ *)