helm/www/lambdadelta/bin/index/index.ml

   1 module KF = Filename
   2 module KP = Printf
   3 module KU = Unix
   4
   5 let out_entry dname och dirs name =
   6   let fname = KF.concat dname name in
   7   let stats = KU.lstat fname in
   8   match stats.KU.st_kind with
   9   | KU.S_REG ->
  10     KP.fprintf och "    <rlink to=\"%s\">%s</rlink>\n" fname name;
  11     dirs
  12   | KU.S_DIR -> name :: dirs
  13   | _        -> dirs
  14
  15 let list_dir dname och =
  16   let dir = Sys.readdir dname in
  17   Array.sort String.compare dir;
  18   Array.fold_left (out_entry dname och) [] dir
  19
  20 let out_index dname och =
  21   KP.fprintf och "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
  22   KP.fprintf och "<page description=\"\\lambda\\delta home page\"\n";
  23   KP.fprintf och "      title=\"\\lambda\\delta home page\"\n";
  24   KP.fprintf och "      head=\"λδ digital library (LDDL)\"\n";
  25   KP.fprintf och ">\n";
  26   KP.fprintf och "  <sitemap name=\"sitemap\"/>\n";
  27   KP.fprintf och "  <section5 name=\"index\">Index</section5>\n";
  28   KP.fprintf och "  <subsection name=\"current\">\n";
  29
  30   KP.fprintf och "  </subsection>\n";
  31   KP.fprintf och "  <body>\n";
  32   let dirs = list_dir dname och in
  33   KP.fprintf och "  </body>\n";
  34   KP.fprintf och "  <footer><helena-label/></footer>\n";
  35   KP.fprintf och "</page>\n";
  36   dirs
  37
  38 let rec out_dir dname =
  39   let och = open_out (KF.concat dname "index.ldw.xml") in
  40   let dirs = out_index dname och in
  41   close_out och;
  42   let map name = out_dir (KF.concat dname name) in
  43   List.iter map dirs
  44
  45 let help = "Usage: index [ <dir> ]*"
  46
  47 let main =
  48   Arg.parse [
  49   ] out_dir help