Allow pgloader to work on windows.

Makefile

@@ -18,10 +18,18 @@ LIBS       = $(BUILDDIR)/libs.stamp
 QLDIR      = $(BUILDDIR)/quicklisp
 MANIFEST   = $(BUILDDIR)/manifest.ql
 LATEST     = $(BUILDDIR)/pgloader-latest.tgz
-PGLOADER   = $(BUILDDIR)/bin/$(APP_NAME)
 
-BUILDAPP_CCL  = $(BUILDDIR)/bin/buildapp.ccl
+ifeq ($(OS),Windows_NT)
-BUILDAPP_SBCL = $(BUILDDIR)/bin/buildapp.sbcl
+EXE           = .exe
+COMPRESS_CORE = no
+DYNSIZE       = 1024		# support for windows 32 bits
+else
+EXE =
+endif
+
+PGLOADER   = $(BUILDDIR)/bin/$(APP_NAME)$(EXE)
+BUILDAPP_CCL  = $(BUILDDIR)/bin/buildapp.ccl$(EXE)
+BUILDAPP_SBCL = $(BUILDDIR)/bin/buildapp.sbcl$(EXE)
 
 ifeq ($(CL),sbcl)
 BUILDAPP   = $(BUILDAPP_SBCL)
@@ -116,7 +124,9 @@ $(PGLOADER): $(MANIFEST) $(BUILDAPP) $(LISP_SRC)
                          --entry pgloader:main                   \
                          --dynamic-space-size $(DYNSIZE)         \
                          $(COMPRESS_CORE_OPT)                    \
-                         --output $@
+                         --output $@.tmp
+	# that's ugly, but necessary when building on Windows :(
+	mv $@.tmp $@
 
 pgloader: $(PGLOADER) ;
 

Vagrantfile

@@ -40,4 +40,18 @@ Vagrant.configure("2") do |config|
       s.privileged = false
     end
   end
+
+  config.vm.define "w7" do |centos|
+    centos.vm.box = "w7"
+    config.vm.communicator = "winrm"
+
+    config.vm.network :forwarded_port, guest: 5985, host: 5985,
+                      id: "winrm", auto_correct: true
+
+    config.vm.network :forwarded_port, guest: 3389, host: 3389,
+                      id: "rdp", auto_correct: true
+
+    config.vm.network :forwarded_port, guest: 1433, host: 1433,
+                      id: "mssql", auto_correct: true
+  end
 end

debian/control

@@ -3,7 +3,7 @@ Section: database
 Priority: extra
 Maintainer: Dimitri Fontaine <dim@tapoueh.org>
 Uploaders: Christoph Berg <myon@debian.org>
-Build-Depends: debhelper (>= 8.0.0), sbcl (>= 1.1.13), ruby-ronn, buildapp (>= 1.5), cl-asdf (>= 3.0.3), cl-log, cl-postmodern, cl-simple-date, cl-qmynd, cl-split-sequence, cl-unicode, cl-interpol, cl-csv, cl-fad, cl-lparallel, cl-esrap, cl-alexandria, cl-drakma, cl-flexi-streams, cl-usocket, cl-local-time, cl-command-line-arguments, cl-abnf, cl-db3, cl-py-configparser, cl-sqlite, cl-trivial-backtrace, cl-markdown, cl-md5, cl-asdf-finalizers, cl-asdf-system-connections, cl-cffi (>= 1:0.12.0), cl-ixf, gawk, cl-bordeaux-threads (>= 0.8.3), cl-metabang-bind
+Build-Depends: debhelper (>= 8.0.0), sbcl (>= 1.1.13), ruby-ronn, buildapp (>= 1.5), cl-asdf (>= 3.0.3), cl-log, cl-postmodern, cl-simple-date, cl-qmynd, cl-split-sequence, cl-unicode, cl-interpol, cl-csv, cl-fad, cl-lparallel, cl-esrap, cl-alexandria, cl-drakma, cl-flexi-streams, cl-usocket, cl-local-time, cl-command-line-arguments, cl-abnf, cl-db3, cl-py-configparser, cl-sqlite, cl-trivial-backtrace, cl-markdown, cl-md5, cl-asdf-finalizers, cl-asdf-system-connections, cl-cffi (>= 1:0.12.0), cl-ixf, gawk, cl-bordeaux-threads (>= 0.8.3), cl-metabang-bind, cl-mssql
 Standards-Version: 3.9.5
 Homepage: https://github.com/dimitri/pgloader
 Vcs-Git: https://github.com/dimitri/pgloader.git
@@ -11,7 +11,7 @@ Vcs-Browser: https://github.com/dimitri/pgloader
 
 Package: pgloader
 Architecture: any
-Depends: ${shlibs:Depends}, ${misc:Depends}
+Depends: ${shlibs:Depends}, ${misc:Depends}, freetds
 Description: extract, transform and load data into PostgreSQL
  pgloader imports data from different kind of sources and COPY it into
  PostgreSQL.

pgloader.asd

@@ -31,6 +31,7 @@
 		 #:trivial-backtrace  	; For --debug cli usage
                  #:cl-markdown          ; To produce the website
                  #:metabang-bind        ; the bind macro
+                 ;#:cl-mssql             ; M$ SQL connectivity
 		 )
     :components
     ((:module "src"

src/main.lisp

@@ -71,7 +71,7 @@
   " If the logfile has not been given by the user, default to using
     pgloader.log within *root-dir*."
   (cond ((null logfile)
-	 (make-pathname :directory (directory-namestring *root-dir*)
+	 (make-pathname :defaults *root-dir*
 			:name "pgloader"
 			:type "log"))
 

src/params.lisp

@@ -53,6 +53,15 @@
                (if *release* *minor-version* (git-hash)))
   "pgloader version strings, following Emacs versionning model.")
 
+;;;
+;;; We need that to setup our default connection parameters
+;;;
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun getenv-default (name &optional default)
+    "Return the value of the NAME variable as found in the environment, or
+     DEFAULT if that variable isn't set"
+    (or (uiop:getenv name) default)))
+
 ;; we can't use pgloader.utils:make-pgstate yet because params is compiled
 ;; first in the asd definition, we just make the symbol a special variable.
 (defparameter *state* nil
@@ -62,11 +71,16 @@
   "Where to load CSV files from, when loading from an archive.")
 
 (defparameter *root-dir*
-  (make-pathname :directory "/tmp/pgloader/")
+  #+unix (make-pathname :directory "/tmp/pgloader/")
+  #-unix (uiop:merge-pathnames*
+          "pgloader/"
+          (uiop:ensure-directory-pathname (getenv-default "Temp")))
   "Top directory where to store all data logs and reject files.")
 
 (defparameter *log-filename*
-  (make-pathname :directory "/tmp/pgloader/" :name "pgloader" :type "log")
+  (make-pathname :defaults *root-dir*
+                 :name "pgloader"
+                 :type "log")
   "Main pgloader log file")
 
 (defparameter *client-min-messages* :notice)
@@ -87,15 +101,6 @@
 (defparameter *concurrent-batches* 10
   "How many batches do we stack in the queue in advance.")
 
-;;;
-;;; We need that to setup our default connection parameters
-;;;
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun getenv-default (name &optional default)
-    "Return the value of the NAME variable as found in the environment, or
-     DEFAULT if that variable isn't set"
-    (or (uiop:getenv name) default)))
-
 ;;;
 ;;; PostgreSQL Connection Credentials and Session Settings
 ;;;
@@ -120,9 +125,11 @@
 ;;;
 (defparameter *default-tmpdir*
   (let* ((tmpdir (uiop:getenv "TMPDIR"))
-	 (tmpdir (or (and tmpdir (probe-file tmpdir)) "/tmp"))
+	 (tmpdir (or (and tmpdir (probe-file tmpdir))
-	 (tmpdir (fad:pathname-as-directory tmpdir)))
+                     #+unix #P"/tmp/"
-    (fad:pathname-as-directory (merge-pathnames "pgloader" tmpdir)))
+                     #-unix (uiop:ensure-directory-pathname
+                             (getenv-default "Temp")))))
+    (uiop:ensure-directory-pathname (merge-pathnames "pgloader" tmpdir)))
   "Place where to fetch and expand archives on-disk.")
 
 ;;;

src/parsers/parser.lisp

@@ -332,8 +332,12 @@
       (let ((user
 	     (or user
 		 (case type
-		   (:postgresql (getenv-default "PGUSER" (getenv-default "USER")))
+		   (:postgresql
-		   (:mysql      (getenv-default "USER")))))
+                    (getenv-default "PGUSER"
+                                    #+unix (getenv-default "USER")
+                                    #-unix (getenv-default "UserName")))
+		   (:mysql
+                    (getenv-default "USER")))))
           (password (or password
               (case type
                 (:postgresql (getenv-default "PGPASSWORD"))
@@ -702,7 +706,7 @@
     (destructuring-bind (kind path) filename
       (ecase kind
         (:filename
-         (pgloader.sql:read-queries (merge-pathnames path *cwd*)))))))
+         (pgloader.sql:read-queries (uiop:merge-pathnames* path *cwd*)))))))
 
 (defrule before-load-execute (and kw-before kw-load kw-execute sql-file)
   (:lambda (ble)
@@ -1149,10 +1153,9 @@ load database
                      (progn
                        (with-stats-collection ("extract" :state state-before)
                          (let ((d (pgloader.archive:expand-archive db)))
-                           (merge-pathnames
+                           (make-pathname :defaults d
-                            (make-pathname :name (pathname-name db)
+                                          :name (pathname-name db)
-                                           :type "db")
+                                          :type "db"))))
-                            d))))
                      db))
                 (source
                  (make-instance 'pgloader.sqlite::copy-sqlite
@@ -1368,10 +1371,9 @@ load database
                      (progn
                        (with-stats-collection ("extract" :state state-before)
                          (let ((d (pgloader.archive:expand-archive source)))
-                           (merge-pathnames
+                           (make-pathname :defaults d
-                            (make-pathname :name (pathname-name source)
+                                          :name (pathname-name source)
-                                           :type "dbf")
+                                          :type "dbf"))))
-                            d))))
                      source))
                 (source
                  (make-instance 'pgloader.db3:copy-db3
@@ -1448,10 +1450,9 @@ load database
                      (progn
                        (with-stats-collection ("extract" :state state-before)
                          (let ((d (pgloader.archive:expand-archive source)))
-                           (merge-pathnames
+                           (make-pathname :defaults d
-                            (make-pathname :name (pathname-name source)
+                                          :name (pathname-name source)
-                                           :type "ixf")
+                                          :type "ixf"))))
-                            d))))
                      source))
                 (source
                  (make-instance 'pgloader.ixf:copy-ixf
@@ -2175,8 +2176,8 @@ load database
   (loop
      for s-exp in command
      when (pathnamep s-exp)
-     collect (if (fad:pathname-relative-p s-exp)
+     collect (if (uiop:relative-pathname-p s-exp)
-		 (merge-pathnames s-exp (directory-namestring filename))
+		 (uiop:merge-pathnames* s-exp filename)
 		 s-exp)
      else
      collect (if (and (consp s-exp) (listp (cdr s-exp)))
@@ -2196,7 +2197,7 @@ load database
 
   (process-relative-pathnames
    filename
-   (let ((*cwd* (directory-namestring filename))
+   (let ((*cwd* (make-pathname :defaults filename :name nil :type nil))
          (*data-expected-inline* nil)
 	 (content (read-file-into-string filename)))
      (multiple-value-bind (commands end-commands-position)

src/pgsql/queries.lisp

@@ -31,7 +31,7 @@
 	     (set-session-gucs *pg-settings* :transaction t)
 	     ,@forms)))
       ;; no database given, create a new database connection
-      `(let ((cl-postgres::*unix-socket-dir* (get-unix-socket-dir))
+      `(let (#+unix (cl-postgres::*unix-socket-dir* (get-unix-socket-dir))
              ;; if no dbname is given at macro-expansion time, we want to
              ;; use the current value of *pg-dbname* at run time
              (*pg-dbname* (or ,dbname *pg-dbname*)))
@@ -46,7 +46,7 @@
 (defmacro with-pgsql-connection ((dbname) &body forms)
   "Run FROMS within a PostgreSQL connection to DBNAME. To get the connection
    spec from the DBNAME, use `get-connection-spec'."
-  `(let ((cl-postgres::*unix-socket-dir*  (get-unix-socket-dir)))
+  `(let (#+unix (cl-postgres::*unix-socket-dir*  (get-unix-socket-dir)))
      (pomo:with-connection (get-connection-spec ,dbname)
        (log-message :debug "CONNECT ~s" (get-connection-spec ,dbname))
        (set-session-gucs *pg-settings*)

src/utils/archive.lisp

@@ -12,7 +12,7 @@
   (log-message :log "Fetching '~a'" url)
 
   (ensure-directories-exist tmpdir)
-  (let ((archive-filename (make-pathname :directory (namestring tmpdir)
+  (let ((archive-filename (make-pathname :defaults tmpdir
 					 :name (pathname-name url)
 					 :type (pathname-type url))))
     (multiple-value-bind (http-stream

src/utils/logs.lisp

@@ -28,7 +28,7 @@
 		       :message-class 'formatted-message))
 
   ;; we need an existing place where to log our messages
-  (ensure-directories-exist (directory-namestring log-filename))
+  (ensure-directories-exist log-filename)
 
   (push (cl-log:start-messenger 'text-file-messenger
 				:name "logfile"

src/utils/state.lisp

@@ -32,30 +32,30 @@
   (or (pgstate-get-table pgstate table-name)
       (let* ((table (setf (gethash table-name (pgstate-tables pgstate))
 			  (make-pgtable :name table-name)))
-	     (reject-dir (pathname-directory
+	     (reject-dir    (merge-pathnames (format nil "~a/" dbname) *root-dir*))
-			  (merge-pathnames
+	     (data-pathname (make-pathname :defaults reject-dir
-			   (format nil "~a/" dbname) *root-dir*)))
+                                           :name table-name :type "dat"))
-	     (data-pathname
+	     (logs-pathname (make-pathname :defaults reject-dir
-	      (make-pathname :directory reject-dir :name table-name :type "dat"))
+                                           :name table-name :type "log")))
-	     (logs-pathname
-	      (make-pathname :directory reject-dir :name table-name :type "log")))
 
         ;; maintain the ordering
         (push table-name (pgstate-tabnames pgstate))
 
 	;; create the per-database directory if it does not exists yet
-	(ensure-directories-exist (directory-namestring data-pathname))
+	(ensure-directories-exist reject-dir)
 
 	;; rename the existing files if there are some
+        (when (probe-file data-pathname)
           (with-open-file (data data-pathname
                                 :direction :output
                                 :if-exists :rename
-			      :if-does-not-exist nil))
+                                :if-does-not-exist nil)))
 
+        (when (probe-file logs-pathname)
           (with-open-file (logs logs-pathname
                                 :direction :output
                                 :if-exists :rename
-			      :if-does-not-exist nil))
+                                :if-does-not-exist nil)))
 
 	;; set the properties to the right pathnames
 	(setf (pgtable-reject-data table) data-pathname