mirrors/pgloader
1
0
Fork 0
mirror of https://github.com/dimitri/pgloader.git synced 2025-08-08 23:37:00 +02:00
Code Issues Projects Releases Wiki Activity

Implement support for gzip and tarball archives format, see #80.

Browse Source
This commit is contained in:
Dimitri Fontaine 2014-08-06 22:53:51 +02:00
parent 68dc8e07b4
commit b4ec0ec52f
1 changed files with 42 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
src/archive.lisp
View File

@ -42,11 +42,47 @@
;; return the pathname where we just downloaded the file ;; return the pathname where we just downloaded the file
archive-filename)) archive-filename))
(defun archive-type (archive-file)
"Return one of :tar, :gz or :zip depending on ARCHIVE-FILE pathname extension."
(multiple-value-bind (abs paths filename no-path-p)
(uiop:split-unix-namestring-directory-components
(uiop:native-namestring archive-file))
(declare (ignore abs paths no-path-p))
(let ((dotted-parts (reverse (sq:split-sequence #\. filename))))
(destructuring-bind (extension name-or-ext &rest parts)
dotted-parts
(declare (ignore parts))
(if (string-equal "tar" name-or-ext) :tar
(intern (string-upcase extension) :keyword))))))
(defun unzip (archive-file expand-directory) (defun unzip (archive-file expand-directory)
"Unzip an archive" "Unzip an archive"
;; TODO: fallback to the following if the unzip command is not found ;; TODO: fallback to the following if the unzip command is not found
;; (zip:unzip archive-file expand-directory :if-exists :supersede) ;; (zip:unzip archive-file expand-directory :if-exists :supersede)
(let ((command (format nil "unzip -o ~a -d ~a" archive-file expand-directory))) (let ((command (format nil "unzip -o ~s -d ~s"
(uiop:native-namestring archive-file)
(uiop:native-namestring expand-directory))))
(log-message :notice "~a" command)
(uiop:run-program command)))
(defun gunzip (archive-file expand-directory)
"Unzip a gzip formated archive"
(let ((command (format nil "gunzip -c ~s > ~s"
(uiop:native-namestring archive-file)
(uiop:native-namestring (pathname-name archive-file))))
(cwd (uiop:getcwd)))
(log-message :notice "~a" command)
(unwind-protect
(progn
(uiop:chdir expand-directory)
(uiop:run-program command))
(uiop:chdir cwd))))
(defun untar (archive-file expand-directory)
"Untar an archive"
(let ((command (format nil "tar xf ~s -C ~s"
(uiop:native-namestring archive-file)
(uiop:native-namestring expand-directory))))
(log-message :notice "~a" command) (log-message :notice "~a" command)
(uiop:run-program command))) (uiop:run-program command)))
@ -61,12 +97,15 @@
(error "File does not exists: '~a'." archive-file)) (error "File does not exists: '~a'." archive-file))
(let* ((archive-name (pathname-name archive-file)) (let* ((archive-name (pathname-name archive-file))
(archive-type (archive-type (archive-type archive-file))
(intern (string-upcase (pathname-type archive-file)) :keyword))
(expand-directory (expand-directory
(fad:pathname-as-directory (merge-pathnames archive-name tmpdir)))) (fad:pathname-as-directory (merge-pathnames archive-name tmpdir))))
(ensure-directories-exist expand-directory) (ensure-directories-exist expand-directory)
(ecase archive-type (ecase archive-type
(:tar (untar archive-file expand-directory))
(:tgz (untar archive-file expand-directory))
(:gz (gunzip archive-file expand-directory))
(:zip (unzip archive-file expand-directory))) (:zip (unzip archive-file expand-directory)))
;; return the pathname where we did expand the archive ;; return the pathname where we did expand the archive
expand-directory)) expand-directory))