um pacote pra renomear sem sobrescrever

[Patricia Ferreira]

(*) Introdução

Common Lisp possui rename-file, mas rename-file usa rename(2) em
sistemas GNU, que sobrescreve o arquivo de destino se ela já
existir---destrói o arquivo de destino. Em sistemas Windows,
rename-file explicitamente pede ao kernel pra sobrescrever o arquivo de
destino, apesar do kernel por padrão retornar erro quando o destino já
existe.

--8<---------------cut here---------------start------------->8---
(defconstant +movefile-replace-existing+ 1)

(defun sb-unix:unix-rename (name1 name2)
(declare (type sb-unix:unix-pathname name1 name2))
(syscall (("MoveFileEx" t) lispbool system-string system-string dword)
(values result (if result 0 (get-last-error)))
name1 name2 +movefile-replace-existing+))

Fonte:
https://github.com/sbcl/sbcl/blob/master/src/code/win32.lisp
--8<---------------cut here---------------end--------------->8---

Por exemplo,

%ls 1 2 3
1 2 3

RENAME> (rename-file "2" "1"))
#P"c:/rename/1"
#P"c:/rename/2"
#P"c:/rename/1"

Pronto---destruído seu arquivo 1.

Esse comportamento nos impede de usar rename-file como primitiva atômica
pra alocar um nome num diretório. Quando temos múltiplos processos
escrevendo registros num diretório, precisamos alocar o registro de
forma atômica: pode ser que dois processos tenham escolhido o mesmo
nome---por exemplo, final.txt---e aí o que terminar por último
sobrescreverá o trabalho do outro. O que desejamos é impedir que o
atrasado sobrescreva o produto de quem terminou primeiro. O pacote
abaixo usa a interface de funções estrangeiras pra nos dar acesso a
renameat2(2) em sistemas GNU e MoveFileExA em sistemas Windows. O /A/
em MoveFileExA significa que não suportamos Unicode em nome de arquivos
no Windows.

(*) Como instalar o pacote

Coloque os arquivos em local-projects---é preciso já ter Quicklisp.

%find ~/quicklisp/local-projects/rename/
c:/[...]/quicklisp/local-projects/rename/
c:/[...]/quicklisp/local-projects/rename/rename.asd
c:/[...]/quicklisp/local-projects/rename/rename.lisp

(*) Como usar o pacote

%ls 1 2 3
1 2 3

CL-USER> (ql:quickload "rename")
To load "rename":
Load 1 ASDF system:
rename
; Loading "rename"

("rename")

CL-USER> (in-package :rename)
#<PACKAGE "RENAME">

RENAME> (rename-noreplace "2" "1")
-1 ;; não sobrescreveu

RENAME> (rename-noreplace "2" "2.new")
0

%ls 1 2 3 2.new
2: No such file or directory
1 2.new 3

(*) O pacote RENAME

O pacote abaixo define o procedimento rename-noreplace, que retornará
NIL se o nome de destino já existir. Se o kernel for nem Win32 nem
Linux, recaímos pra rename-file. Essa decisão fará meu programa
funcionar como quero, mas é questionável---talvez o melhor seja
simplesmente lançar uma exceção dizendo que o sistema não é suportado.
Ou então definimos que o pacote

Arquivo c:/[...]/quicklisp/local-projects/rename/rename.asd.

--8<---------------cut here---------------start------------->8---
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RENAME; -*-
(asdf:defsystem :rename
:version "0.1"
:description "An interface to Linux's renameat2 and Win32's MoveFileExA."
:depends-on (:cffi)
:components ((:file "rename")))
--8<---------------cut here---------------end--------------->8---

c:/[...]/quicklisp/local-projects/rename/rename.lisp.

--8<---------------cut here---------------start------------->8---
;;; -*- mode: LISP; syntax: COMMON-LISP; package: RENAME; -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload '(:cffi) :silent t))

(defpackage :rename
(:use :common-lisp :cffi :sb-alien)
(:export :rename-noreplace))

(in-package :rename)

(define-foreign-library libc
(:unix (:or "libc.so.6" "libc.so"))
(:win32 "kernel32.dll"))

(use-foreign-library libc)

(defcfun "rename" :int (oldpath :string) (newpath :string))
(defcfun "renameat2" :int
(olddirfd :int) (oldpath :string)
(newdirfd :int) (newpath :string) (flags :int))

(defcfun "MoveFileExA" :int
(lpexistingfilename :string)
(lpnewfilename :string)
(dwflags :int))

(defconstant at-fdcwd -100 "See rename(2) in the Linux Programmer's Manual.")
(defconstant flag-noreplace 1 "See rename(2) in the Linux Programmer's Manual.")

#+linux
(defun rename-noreplace (old new)
;; Returns T if okay; NIL otherwise.
(or (= 0 (renameat2 at-fdcwd old at-fdcwd new flag-noreplace))))

#+win32
(defun rename-noreplace (old new)
;; Returns T if okay; NIL otherwise.
(or (= 1 (MoveFileExA old new 0))))

#-(or win32 linux)
(defun rename-noreplace (old new)
;; Unfortunately, we cannot guarantee atomicity. Returns pathnames
;; if okay. NIL otherwise.
(or (rename-file old new))
--8<---------------cut here---------------end--------------->8---

[Patricia Ferreira]

Patricia Ferreira <pfer...@example.com> writes:

[...]

> #-(or win32 linux)
> (defun rename-noreplace (old new)
> ;; Unfortunately, we cannot guarantee atomicity. Returns pathnames
> ;; if okay. NIL otherwise.
> (or (rename-file old new))

Faltou um parêntese aí.

#-(or win32 linux)
(defun rename-noreplace (old new)
;; Unfortunately, we cannot guarantee atomicity. Returns pathnames
;; if okay. NIL otherwise.

(or (rename-file old new)))