#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do pg2edb)' -s $0 "$@" # -*-scheme-*-
!#
;;; pg2edb

;; Copyright (C) 2008, 2009, 2010, 2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; NOTE: This program is still EXPERIMENTAL.
;;
;; Usage: pg2edb [options] TABLE
;;
;; Analyze PostgreSQL table TABLE; display inferred defs to stdout;
;; dump combined schema/data to stdout in EDB "inherent data" format.
;;
;; -d, --database NAME  -- connect to db name (default: user name)
;; -o, --output FILE    -- write "inherent data" format to FILE
;; -E, --encoding ENC   -- use client encoding ENC (default: "UNICODE")

;;; Code:

(define-module (ttn-do pg2edb)
  #:export (main)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((database postgres-meta) #:select (defs-from-psql))
  #:use-module ((database postgres) #:select (pg-set-client-encoding!))
  #:use-module ((database postgres-types) #:select (define-db-col-type))
  #:use-module ((database postgres-col-defs) #:select (column-name
                                                       type-name))
  #:use-module ((database postgres-table) #:select (pgtable-worker))
  #:use-module ((ice-9 rdelim) #:select (write-line))
  #:use-module ((ice-9 format) #:select (format))
  #:use-module ((ttn-do mogrify) #:select (editing-buffer))
  #:use-module ((ice-9 popen) #:select (open-input-pipe))
  #:use-module ((ttn-do zzz personally) #:select (FE)))

(define-db-col-type 'timestamp "1970-01-01 00:00:00"
  (lambda (time)
    (cond ((string? time) time)
          ((number? time) (strftime "%F %T" (localtime time)))
          (else (error "bad timestamp-type input:" time))))
  (lambda (string)
    (if (string-null? string)
        0
        (car (mktime (car (strptime "%Y-%m-%d %T" string)))))))

(define *pg2edb-typemap*
  '((integer integer-or-nil)
    (smallint integer-or-nil)
    (timestamp integer-or-nil)))

(define (fso s . args)
  (apply format #t s args))

(define (dso s . args)
  (apply format (current-error-port) s args))

(define (edb-field-defs defs)
  (map (lambda (def)
         (let ((name (column-name def))
               (type (type-name def)))
           (cons name (cond ((assq-ref *pg2edb-typemap* type) => car)
                            (else 'string-or-nil)))))
       defs))

(define (main/qop qop)
  (let* ((database (or (qop 'database) (passwd:name (getpw (getuid)))))
         (table (car (qop '())))
         (defs (defs-from-psql #t database (object->string table)))
         (names (map car defs))
         (oport (qop 'output open-output-file))
         (maxname (apply max (map string-length (map symbol->string names))))
         (tw (pgtable-worker database table defs)))
    (dso "~Y~%" defs)
    (and oport (set-current-output-port oport))
    (fso ":EDB (single) ;;;-*-emacs-lisp-*-~%~%")
    (fso ":name \"database:~A table:~A\"~%~%" database table)
    (fso ":fields [~{~A~^ ~}]~%~%" (edb-field-defs defs))
    (fso ":display t~%")
    (FE names (lambda (field)
                (fso " ~V@A: \\~A~%" maxname field field)))
    (fso ":EOTB~%~%")
    (fso ":summary-format \"~{\\\\~A~^ ~}\"~%~%" names)
    (fso "~A ~A~%" ':data '(:coding t :seqr read-line :seqw write-line))
    (pg-set-client-encoding! (tw #:k #:connection) (or (qop 'encoding)
                                                       "UNICODE"))
    (if #t
        (let ((rows (tw #:tuples-result->rows (tw #:select #t ;; #:limit 3
                                                  ))))
          (FE rows (lambda (row)
                     (fso "[~{~S~^ ~}]~%" (map (lambda (x)
                                                 (or x 'nil))
                                               row)))))
        (let* ((pre (format #f "\\encoding ~A \\\\ SELECT * FROM ~S"
                            (or (qop 'encoding) "UNICODE")
                            table))
               (opt "-At -F '\t' -Ppager=off")
               (cmd (format #f "echo '~A' | psql ~A -d ~S" pre opt database)))
          (editing-buffer (open-input-pipe cmd)
            (goto-char (point-min))
            (while (search-forward "\"" (point-max) 1)
              (replace-match "\\\"" #f #t))
            (while (search-backward "\t" (point-min) 1)
              (replace-match "\" \""))
            (while (< (point) (point-max))
              (let ((p (point)))
                (insert "[\"") (end-of-line) (insert "\"]")
                (forward-line 1)
                (write-to-port (current-output-port) p (point)))))))
    (fso ":EOTB~%")
    (and oport (close-port oport))
    #t))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "0.1")
                   (help . commentary)))
  (main/qop
   (qop<-args
    args '((encoding (single-char #\E) (value #t))
           (output (single-char #\o) (value #t))
           (database (single-char #\d) (value #t))))))

;;; pg2edb ends here