(*
    HLins: insert http-links into HTML documents.
    See http://www.lri.fr/~treinen/hlins

    Copyright (C) 1999 Ralf Treinen <treinen@lri.fr>

    This program 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.

    This program 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 this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

*)


open Arg;;
open Str;;
open Errors;;
open Files;;
open Dumpdb;;

(*************************************************************************)
(* process options *)

let dblist = ref [];;
let out_filename = ref "";;
let in_filename = ref "";;
let mlist = ref [];;
let quiet = ref false;;
let recursivemode = ref false;;
let dbtohtmlmode = ref false;;
let tmpdir =
  ref (try Unix.getenv "TMPDIR"
       with Not_found -> "/tmp");;
    
let description = "Hlins: insert urls into a file." in
let rec dbact = function s -> dblist := !dblist @ (split (regexp "[ \t\n]+") s)
and mact = function s -> mlist := !mlist @ (split (regexp "[ \t\n]+") s)
and oact = function s -> 
  if !out_filename = ""
  then out_filename := s
  else stopwitherror "Multiple \"-o\" option"
and tact = function s -> tmpdir := s
and printversion = function () ->
  begin
    print_string ("Hlins v"^Version.version);
    print_newline ();
    exit 0
  end
and printusage = function () ->
  begin
    usage optionsspec description;
    exit 0
  end
and optionsspec =
  [ ( "-db",
      String (dbact),
      "list of address database files"
    );
    ( "--data-bases",
      String (dbact),
      "list of address database files"
    );
    ( "-o",
      String (oact),
      "output file"
    );
    ( "--output-file",
      String (oact),
      "output file"
    );
    ( "-m",
      String (mact),
      "file to be modified"
    );
    ( "--modify",
      String (mact),
      "file to be modified"
    );
    ( "-R",
      Set recursivemode,
      "descend recursively directories"
    );
    ( "--recursive",
      Set recursivemode,
      "descend recursively directories"
    );
    ( "-td",
      String (tact),
      "temp directory"
    );
    ( "--temp-dir",
      String (tact),
      "temp directory"
    );
    ( "--db-to-html",
      Set dbtohtmlmode,
      "dump databases as html to stdout"
    );
    ( "-q",
      Set quiet,
      "supress diagnostic output"
    );
    ( "--quiet",
      Set quiet,
      "supress diagnostic output"
    );
    ( "-v",
      Unit(printversion),
      "show version and exit"
    );
    ( "--version",
      Unit(printversion),
      "show version and exit"
    );
    ( "-h",
      Unit(printusage),
      "show this usage info"
    );
    ( "--help",
      Unit(printusage),
      "show this usage info"
    )
  ]
  in
    parse optionsspec
	(function s -> 
	   if !in_filename = ""
	   then in_filename := s
	   else stopwitherror "Multiple input files.")
	description;;

if samefile !out_filename !in_filename
then stopwitherror "Input and output files must differ";;

(* check for mutually exclusive options *)
let exclusiveopts o1 o2 =
  stopwitherror
    ( "options " ^o1^ " and " ^o2^ " exclude are each other." )
  ;;

if !dbtohtmlmode
then
  if !mlist <> []
  then exclusiveopts "--db-to-html" "-m (--modify)"
  else if !out_filename <> ""
  then exclusiveopts "--db-to-html" "-o (--output-file)"
  else ()
else
  if !mlist <> [] && !out_filename <> ""
  then exclusiveopts "-o (--output-file)" "-m (--modify)"

  
(***************************************************************************)
(* functions for the different modi of hlins *)

(* function that acts like a filter on channels. On termination
   both channels are closed.
*)
let hlins_filter automaton replace inc ouc =
  Run_automaton.run
    automaton
    (Lexing.from_channel inc)
    replace
    ouc;
  close_in inc;
  close_out ouc
;;

(* function that acts by modification on a file *)
let hlins_modify automaton replace tmpfile filename =
  hlins_filter automaton replace 
    (try open_in filename
     with Sys_error s ->
       stopwitherror ("Cannot read  input file "^filename^": "^s))
    (try open_out tmpfile
     with Sys_error s -> stopwitherror
	 ("Cannot open temporary file "^tmpfile^": "^s));
    move tmpfile filename
;;

(* function that acts on input file and output file *)
let hlins_fromto automaton replace infile outfile =
  hlins_filter
    automaton
    replace
    (if infile <> ""
     then
       try open_in infile
       with Sys_error s -> stopwitherror ("Cannot read  input file "^s)
     else
       stdin
    )
    (if outfile <> ""
     then
       try open_out outfile
       with Sys_error s -> stopwitherror ("Cannot open output file "^s)
     else
       stdout
    )
;;

(* function that acts recursively on a directory *)
let rec hlins_dir automaton replace tmpfile path dir =
  let (htmlfiles,subdirectories) = scandir path dir
  in
    begin
      List.iter
	(function f -> hlins_modify automaton replace tmpfile 
	     (path^"/"^dir^"/"^f))
	htmlfiles;
      List.iter
	(function d -> hlins_dir automaton replace tmpfile 
	     (path^"/"^dir) d)
	subdirectories
    end
;;

(***************************************************************************)
(* now do it *)

let hitcount = ref 0;;

if not !quiet then
      prerr_string ("Hlins version "^Version.version^".\n");;

let (name_list,url_list) = Read_databases.read_dbs !dblist
in let urls = Array.of_list url_list
in
  if !dbtohtmlmode
  then dumpdb name_list urls
  else
    let names = Array.of_list name_list
    in let automaton = Build_automaton.build name_list
       and replace = Replace.replace_function !quiet names urls hitcount
    in
      Gc.compact ();
      if !mlist = []
      then
	hlins_fromto automaton replace !in_filename !out_filename
      else
	let tmpfile = newtmpfile !tmpdir
	in
	  if !recursivemode
	  then
	    let (htmlfiles,subdirectories) =
	      select "." (expanddot !mlist)
	    in
	      begin
		List.iter
		  (function f -> hlins_modify automaton replace tmpfile f)
		  htmlfiles;
		List.iter
		  (function d -> hlins_dir automaton replace tmpfile "." d)
		  subdirectories
	      end
	  else
	    List.iter
	      (function f -> hlins_modify automaton replace tmpfile f)
	      !mlist
;;


if not !quiet
then prerr_string
  ("Number of insertions: " ^ (string_of_int !hitcount) ^"\n");;
flush stderr;;
















