Path: csiph.com!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Patricia Ferreira <pferreira@example.com>
Newsgroups: pt.comp.programacao
Subject: um pacote pra renomear sem sobrescrever
Date: Tue, 23 Jan 2024 22:29:31 -0300
Organization: A noiseless patient Spider
Lines: 149
Message-ID: <87plxrikn8.fsf@example.com>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: 8bit
Injection-Info: dont-email.me; posting-host="a371e9e28cbc90dcf955975abd5071af"; logging-data="1601529"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/7w6ZnOJZeX9xHkVkxFPJpLIk4esYVM2c="
Cancel-Lock: sha1:7Ixn46Fjz6PA1fk87/f0V64cIAQ= sha1:5bEzhXp/vvUa3M7WXqOCM23RWQk=
Xref: csiph.com pt.comp.programacao:189

(*) 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---