[help-ferret] Ferret file structure and a script for postgres to ferret...

[Matthew Welland]

Ferret is proving to be useful for me but to get going I had to import my existing Postgresql db so I wrote a little script for that purpose (which I have pasted at the end of this email in case it is helpful for anyone else). Also, I saw there were questions on the list about the file format so I thought I'd post what I grokked from the ferret code in case that was useful also.

Let me know if you'd like to use the script but can't as is, I may write a silex based parser for the SQL reading (currently it is just a few simple regexps and extend the heuristics to work for more than just a Postgresql dump file.

The file format seems to be (note: the comments are NOT part of the file)

========start file format========

ProjectName

PathToFile

AuthorName

entitySeqNum

relationSeqNum

0 0 800 1024 # initial window geometry

numEntities # i.e. number of tables

entName

xEntLocOnScreen

yEntLocOnScreen

numAttributes

attrib1

attrib2

...

numKeys

key1

key2

...

numRelations

relationName

reflexive

xRelLocOnScreen

yRelLocOnScreen

numAttrib

attrib1

attrib2

...

numEntities # don't know what this is - didn't use it.

entName

entMinCard

endMaxCard

...

==========end file format=========

The script for importing sql into ferret:

;;=======================================

;; save as sql2ferret.scm

;; install chicken: apt-get install chicken

;; compile: csc sql2ferret.scm

;; usage: sql2ferret infile.sql outfile.ger

;; Copyright (C) Matt Welland 2009

;; License GPL

(use regex)

(define inp #f)

(define oup #f)

;; lazy man perlish regex stuff

(define $* #f)

(define (string-match-keep rx str)

(let ((res (string-match rx str)))

(set! $* res)

res))

(define rx-sequence (regexp "^\\s*CREATE SEQUENCE\\s+(\\w+)"))

(define rx-table (regexp "^\\s*CREATE TABLE\\s+(\\w+)"))

(define rx-col-def

(regexp "^\\s+(\\w+)\\s+(\\w+)(,|\\s+|)(DEFAULT nextval.*NOT NULL|)"))

(define rx-endstmt (regexp "^.*;"))

;; process the args

;;

(define (process-args)

(let ((args (argv)))

(if (<= (length args) 2)

(begin

(print "Usage: sql2ferret infile outfile")

(exit))

(let ((infile (cadr args))

(oufile (caddr args)))

(print "Input file: " infile)

(print "Output file: " oufile)

(if (file-exists? infile)

(set! inp (open-input-file infile))

(begin

(print "ERROR: Can't find input file " infile)

(exit)))

(set! oup (open-output-file oufile))))))

;; returns:

;; (("tablename1" ("rowname1" datatype [index]) ...)

;; ("tablename2" ...))

;;

(define (process-sql-file inp)

(let loop ((l (read-line inp))

(res '()))

(cond

((eof-object? l)

(print "Done processing")

(close-input-port inp)

res)

;; CREATE SEQUENCE seqname

;; $* gets seqname

;; ((string-match-keep rx-sequence l)

;; (process-sequence (cadr $*) inp))

;; CREATE TABLE tablename

((string-match-keep rx-table l)

(let ((newdat (process-table (cadr $*) inp)))

(loop (read-line inp)

(cons newdat res))))

(else

(loop (read-line inp)

res)))))

(define (process-sequence seqname inp)

(with-output-to-port oup

(lambda ()

;; (print seqname) ;; another time perhaps :(

(let loop ((l (read-line inp)))

(if (and (not (string-match rx-endstmt l))

(not (eof-object? l)))

(loop (read-line inp)))))))

(define (process-table tablename inp)

(let loop ((l (read-line inp))

(res '()))

(cond

((or (string-match rx-endstmt l)

(eof-object? l)) ;; done

(list tablename (reverse res)))

((string-match-keep rx-col-def l)

(loop (read-line inp)

(cons (cdr $*) res)))

(else

(loop (read-line inp)

res)))))

(define (make-ferret-file oup dat)

;; these will be used to add new items at different locations

;; on the screen to make it a bit easier to find and move things

;; around when getting going

(let ((xoff 10)

(yoff 10))

;; make the file header

(with-output-to-port oup

(lambda ()

(print "ProjectName")

(print "FileName")

(print "AuthorName")

(print 0) ;; start new entities at 0

(print 0) ;; start new relations at 0

(print "0 0 824 768") ;; set the window size

(print (length dat)) ;; this is $sreg - dunno what it is for

;; table

(for-each

(lambda (tabledat)

(let ((tablename (car tabledat))

(cols (cadr tabledat)))

(print tablename)

(print xoff)

(print yoff)

(if (> xoff 800)

(begin

(set! xoff 0)

(set! yoff (+ yoff 100)))

(set! xoff (+ xoff 200)))

(if (> yoff 800)

(set! yoff 0))

;; col

(print (length cols)) ;; number of keys

(let ((keys '()))

(for-each

(lambda (col-dat)

(let ((col-name (car col-dat))

(col-type (cadr col-dat))

(col-key (cadddr col-dat)))

(print col-name " " col-type)

(if (not (string=? col-key ""))

(set! keys (cons col-name keys)))))

cols)

(print (length keys)) ;; number of relations

(if (> (length keys) 0)

(print (string-intersperse keys "\n"))))

(print 0))) ;; number of entities

(reverse dat))

(print 0)))) ;; number of attributes (for the table?)

(close-output-port oup))

(process-args)

(define dat (process-sql-file inp))

(pp dat)

(print "Read " (length dat) " tables")

(make-ferret-file oup dat)