Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > pt.comp.programacao > #189 > unrolled thread

um pacote pra renomear sem sobrescrever

Back to article view | Back to pt.comp.programacao

Contents

  um pacote pra renomear sem sobrescrever Patricia Ferreira <pferreira@example.com> - 2024-01-23 22:29 -0300
    Re: um pacote pra renomear sem sobrescrever Patricia Ferreira <pferreira@example.com> - 2024-01-23 23:00 -0300

#189 — um pacote pra renomear sem sobrescrever

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

[toc] | [next] | [standalone]

#190

Patricia Ferreira <pferreira@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)))

[toc] | [prev] | [standalone]

Back to top | Article view | pt.comp.programacao

csiph-web