(file) Return to import_oasisdb.ml CVS log (file) (dir) Up to [app-camlcityd] / trunk / src / autobuild / import_oasisdb.ml

File: [app-camlcityd] / trunk / src / autobuild / import_oasisdb.ml (download)
Revision: 217, Sun Dec 2 01:35:45 2012 UTC (6 years, 4 months ago) by gerd
File size: 8154 byte(s)
fix dep parsing

(* Scans data from oasisdb, and creates records in godi_autobuild.
   This is especially intended for the translation of findlib
   dependencies into package dependencies
 *)

open Printf
open Autobuild_db

module J = Json_type
module JB = Json_type.Browse

let get url =
  Http_client.Convenience.http_get url

let oasis_url = 
  ref "http://oasis.ocamlcore.org/dev"

let oasis_db_url() = 
  !oasis_url ^ "/api/0.1"

let oasis_db_download name version tarball =
  !oasis_url ^ "/dist/" ^ Netencoding.Url.encode ~plus:false name
    ^ "/" ^ Netencoding.Url.encode ~plus:false version ^ "/" ^ 
     Netencoding.Url.encode ~plus:false tarball

type oasis_pkg =
    { oasis_name : string;
      oasis_version : string;
      oasis_ord : int;
      oasis_tarball : string;
      oasis_download : string
    }

type oasis_pkg_addon =
    { oasis_build_depends : string list;
        (* only main findlib name (w/o subpackage), and w/o version *)
      oasis_provide_findlib : string list
    }


let oasis_list() =
  let url = oasis_db_url() ^ "/json/pkg/list" in
  let list_s = get url in
  let list_j = Json_io.json_of_string list_s in
  List.map
    (fun o ->
       let l = JB.objekt o in
       JB.string (List.assoc "pkg_name" l)
    )
    (JB.array list_j)
        
let oasis_versions name =
  let url =
    oasis_db_url() ^ "/json/pkg_ver/list?pkg=" ^ 
      Netencoding.Url.encode name in
  let list_s = get url in
  let list_j = Json_io.json_of_string list_s in
  List.map JB.string (JB.array list_j)

let oasis_package name version =
  let url =
    oasis_db_url() ^ "/json/pkg_ver/show?pkg=" ^ 
      Netencoding.Url.encode name ^ "&ver=" ^ Netencoding.Url.encode version in
  let pkg_s = get url in
  let pkg_j = Json_io.json_of_string pkg_s in
  let l = JB.objekt pkg_j in
  let out_name = JB.string (List.assoc "pkg" l) in
  let out_version = JB.string (List.assoc "ver" l) in
  let tarball = JB.string (List.assoc "tarball" l) in
  let download_backup = oasis_db_download out_name out_version tarball in
  { oasis_name = out_name;
    oasis_version = out_version;
    oasis_ord = JB.int (List.assoc "ord" l);
    oasis_tarball = tarball;
    oasis_download = download_backup;
      (* ( try JB.string (List.assoc "publink" l)
                       with _ -> download_backup
                     );
       *)
  }

    
let parse_html html_text =
  Nethtml.decode
    ~enc:`Enc_utf8
    ~entity_base:`Html
    ~dtd:Nethtml.relaxed_html40_dtd
    ( Nethtml.parse
        ~dtd:Nethtml.relaxed_html40_dtd
        (new Netchannels.input_string html_text)
    )
    

let get_html_field name html_list =
  let output = ref "" in
  let rec find_tr html =
    match html with
      | Nethtml.Element("tr", atts, sub_list) ->
          ( try
              if List.assoc "id" atts = name then
                List.exists find_td sub_list
              else 
                raise Not_found
            with
              | Not_found -> List.exists find_tr sub_list
          )
      | Nethtml.Element(_, _, sub_list) ->
          List.exists find_tr sub_list
      | Nethtml.Data _ ->
          false
  and find_td html =
    match html with
      | Nethtml.Element("td", atts, sub_list) ->
          output := extract_data html;
          true
      | Nethtml.Element(_, _, sub_list) ->
          List.exists find_td sub_list
      | Nethtml.Data _ ->
          false
  and extract_data html =
    match html with
      | Nethtml.Element(_, _, sub_list) ->
          String.concat "" (List.map extract_data sub_list)
      | Nethtml.Data s ->
          s
  in
  if List.exists find_tr html_list then
    !output
  else
    raise Not_found


let paren_rm_re = Str.regexp "([^)]*)"

let paren_rm s =
  Str.global_replace paren_rm_re "" s

let split_re = Str.regexp "\\([ \t\r\n]*,[ \t\r\n]*\\)"

let ws_re = Str.regexp "[ \t\r\n]+"

let norm_ws s =
  String.concat " " (Str.split ws_re s)
  
let dep_re = Str.regexp "^\\([^ ]+\\)"
  
let extract_dep s =
  if Str.string_match dep_re s 0 then
    Str.matched_group 1 s
  else
    s

let unique l =
  let ht = Hashtbl.create 5 in
  List.filter
    (fun x ->
       if Hashtbl.mem ht x then
         false
       else (
         Hashtbl.add ht x ();
         true
       )
    )
    l


let oasis_package_addon name version =
  let url =
    !oasis_url ^ "/view/" ^ 
      Netencoding.Url.encode ~plus:false name ^ "/" ^
      Netencoding.Url.encode ~plus:false version in
  let pkg_s = get url in
  let pkg_html = parse_html pkg_s in
  let build_depends1 =
    List.map
      norm_ws
      (try Str.split split_re 
             (paren_rm (get_html_field "build_depends" pkg_html))
       with Not_found -> []
      ) in
  let build_depends = unique(List.map extract_dep build_depends1) in
  let provide_findlib1 =
    List.map
      norm_ws
      (try Str.split split_re
             (paren_rm (get_html_field "provide_findlib" pkg_html))
       with Not_found -> []
      ) in
  let provide_findlib = unique(List.map extract_dep provide_findlib1) in
  { oasis_build_depends = build_depends;
    oasis_provide_findlib = provide_findlib 
  }


let import ?(verbose=false) now_int64 db =
  let builder =
    { section = "oasis-import";
      platform = "any";
      hostname = "any";
      source = "oasis-import"
    } in

  let l1 = oasis_list() in
  List.iter
    (fun pkg_name ->
       let l2 = oasis_versions pkg_name in
       List.iter
         (fun pkg_version ->
            try
              let p = oasis_package pkg_name pkg_version in
              let godi_name =
                "oasis-" ^ p.oasis_name in
              let godi_version0 = 
                p.oasis_version ^ "_ord" ^ string_of_int p.oasis_ord in
              let godi_version =
                Str.global_replace (Str.regexp "-") "_" godi_version0 in
              
              if row_exists db builder godi_name godi_version then (
                if verbose then
                  eprintf "Package %s-%s: exists already\n%!"
                    godi_name godi_version
              )
              else (
                if verbose then
                  eprintf "Package %s-%s: %!" godi_name godi_version;
                let addon = oasis_package_addon pkg_name pkg_version in
                let deps =
                  List.map
                    (fun p -> "findlib-" ^ p)
                    addon.oasis_build_depends in
                let deps_s = String.concat "," deps in
                let pkg =
                  { name = godi_name;
                    version = godi_version;
                    status = `Installed;
                    plist_status = `Success;
                    protocol = Buffer.create 0;
                    info = Buffer.create 0;
                    deps = deps_s;
                    build_deps = "";
                    distfiles = p.oasis_download;
                    findlib_provides = 
                      String.concat "," addon.oasis_provide_findlib;
                    bin_provides = ""
                  } in
                store_row now_int64 db builder pkg;
                if verbose then
                  eprintf "imported\n%!"
              )
            with
              | error ->
                  eprintf "ERROR\n%!";
                  eprintf "Exception: %s\n" (Netexn.to_string error)
         )
         l2
    )
    l1


let main() =
  let db_login =
    ref
      { Mysql.dbhost = None;
        dbname = None;
        dbport = None;
        dbpwd = None;
        dbuser = None
      } in
  let verbose = ref false in

  Arg.parse
    ( [ "-verbose", Arg.Set verbose, "   verbose output";
        "-url", Arg.Set_string oasis_url, "<url>   base URL of oasis-db";
      ] @
        (db_options db_login);
    )
    (fun s -> raise(Arg.Bad("Unexpected: " ^ s)))
    (sprintf "usage: %s <options>" (Filename.basename(Sys.argv.(0))));

  let db = Mysql.connect !db_login in
  let now_int64 = Int64.of_float(Unix.time()) in

  let _ = mysql_exec db "START TRANSACTION" in
  check_status db;

  import ~verbose:!verbose now_int64 db;

  let _ = mysql_exec db "COMMIT" in
  check_status db;

  if !verbose then
    eprintf "Committed\n%!"


let () = main()


SVN admin
Powered by
ViewCVS 1.0-dev