File: cp_ex.ml

package info (click to toggle)
cmdliner 0.9.4-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 504 kB
  • ctags: 312
  • sloc: ml: 1,373; sh: 145; makefile: 28
file content (52 lines) | stat: -rw-r--r-- 1,664 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(* Example from the documentation, this code is in public domain. *)

(* Implementation, we check the dest argument and print the args *)

let cp verbose recurse force srcs dest =
  if List.length srcs > 1 && 
  (not (Sys.file_exists dest) || not (Sys.is_directory dest)) 
  then 
    `Error (false, dest ^ " is not a directory") 
  else 
    `Ok (Printf.printf 
	   "verbose = %b\nrecurse = %b\nforce = %b\nsrcs = %s\ndest = %s\n" 
	    verbose recurse force (String.concat ", " srcs) dest)

(* Command line interface *)

open Cmdliner;;

let verbose = 
  let doc = "Print file names as they are copied." in
  Arg.(value & flag & info ["v"; "verbose"] ~doc) 

let recurse = 
  let doc = "Copy directories recursively." in
  Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc)

let force = 
  let doc = "If a destination file cannot be opened, remove it and try again."in
  Arg.(value & flag & info ["f"; "force"] ~doc)

let srcs = 
  let doc = "Source file(s) to copy." in
  Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc) 

let dest = 
  let doc = "Destination of the copy. Must be a directory if there is more 
           than one $(i,SOURCE)." in
  Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv:"DEST" 
         ~doc)

let cmd = 
  let doc = "copy files" in
  let man = [
    `S "BUGS"; 
    `P "Email them to <hehey at example.org>."; 
    `S "SEE ALSO";
    `P "$(b,mv)(1), $(b,scp)(1), $(b,umask)(2), $(b,symlink)(7)" ]
  in
  Term.(ret (pure cp $ verbose $ recurse $ force $ srcs $ dest)), 
  Term.info "cp" ~version:"1.6.1" ~doc ~man

let () = match Term.eval cmd with `Error _ -> exit 1 | _ -> exit 0