X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitacleanLib.ml;h=06c6835ca5797b32b09a38e68c06cc55d88bb526;hb=0a23b2111c404a0a7141a0d5729cf3aa0bdf7798;hp=f8376416e706ebfad00242b502d4b49b5e25f5a8;hpb=6fa3a1e91d8a1e647775ca101255633ba265a9f2;p=helm.git diff --git a/helm/matita/matitacleanLib.ml b/helm/matita/matitacleanLib.ml index f8376416e..06c6835ca 100644 --- a/helm/matita/matitacleanLib.ml +++ b/helm/matita/matitacleanLib.ml @@ -1,3 +1,31 @@ +(* Copyright (C) 2005, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +let debug = false +let debug_prerr = if debug then prerr_endline else ignore + module HGT = Http_getter_types;; module HG = Http_getter;; module HGM = Http_getter_misc;; @@ -70,21 +98,25 @@ let close_uri_list uri_to_remove = in (* now calculate the list of objects that belong to these baseuris *) let uri_to_remove = - List.fold_left - (fun acc buri -> - let inhabitants = HG.ls (buri ^ "/") in - let inhabitants = List.filter - (function HGT.Ls_object _ -> true | _ -> false) - inhabitants - in - let inhabitants = List.map - (function - | HGT.Ls_object e -> buri ^ "/" ^ e.HGT.uri - | _ -> assert false) - inhabitants - in - inhabitants @ acc) - [] buri_to_remove + try + List.fold_left + (fun acc buri -> + let inhabitants = HG.ls (buri ^ "/") in + let inhabitants = List.filter + (function HGT.Ls_object _ -> true | _ -> false) + inhabitants + in + let inhabitants = List.map + (function + | HGT.Ls_object e -> buri ^ "/" ^ e.HGT.uri + | _ -> assert false) + inhabitants + in + inhabitants @ acc) + [] buri_to_remove + with HGT.Invalid_URI u -> + MatitaLog.error ("We were listing an invalid buri: " ^ u); + exit 1 in (* now we want the list of all uri that depend on them *) let depend = @@ -105,7 +137,17 @@ let baseuri_of_file file = List.iter (fun stm -> match baseuri_of_baseuri_decl stm with - | Some buri -> uri := MatitaMisc.strip_trailing_slash buri + | Some buri -> + let u = MatitaMisc.strip_trailing_slash buri in + if String.length u < 5 || String.sub u 0 5 <> "cic:/" then + MatitaLog.error (file ^ " sets an incorrect baseuri: " ^ buri); + (try + ignore(HG.resolve u) + with + | HGT.Unresolvable_URI _ -> + MatitaLog.error (file ^ " sets an unresolvable baseuri: "^buri) + | HGT.Key_not_found _ -> ()); + uri := u | None -> ()) stms; !uri @@ -115,13 +157,19 @@ let rec fix uris next = | [] -> uris | l -> let uris, next = close_uri_list l in fix uris next @ uris -let clean_baseuris buris = +let clean_baseuris ?(verbose=true) buris = + Hashtbl.clear cache_of_processed_baseuri; let buris = List.map HGM.strip_trailing_slash buris in -(* List.iter prerr_endline buris;*) + debug_prerr "clean_baseuris called on:"; + if debug then + List.iter debug_prerr buris; let l = fix [] buris in let l = MatitaMisc.list_uniq (List.fast_sort Pervasives.compare l) in let l = List.map UriManager.uri_of_string l in - List.iter MatitaSync.remove l + debug_prerr "clean_baseuri will remove:"; + if debug then + List.iter (fun u -> debug_prerr (UriManager.string_of_uri u)) l; + List.iter (MatitaSync.remove ~verbose) l let is_empty buri = HG.ls (HGM.strip_trailing_slash buri ^ "/") = []