extra/io/files/trash/unix/unix.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors calendar combinators.short-circuit environment
   5 formatting io io.directories io.encodings.utf8 io.files
   6 io.files.info io.files.info.unix io.files.trash io.files.types
   7 io.pathnames kernel math math.parser sequences system unix.stat
   8 unix.users ;
   9
  10 IN: io.files.trash.unix
  11
  12 ! Implements the FreeDesktop.org Trash Specification 0.7
  13
  14 <PRIVATE
  15
  16 : top-directory? ( path -- ? )
  17     dup ".." append-path [ link-status ] bi@
  18     [ [ st_dev>> ] bi@ = not ] [ [ st_ino>> ] bi@ = ] 2bi or ;
  19
  20 : top-directory ( path -- path' )
  21     [ dup top-directory? not ] [ ".." append-path ] while ;
  22
  23 : make-user-directory ( path -- )
  24     [ make-directories ] [ 0o700 set-file-permissions ] bi ;
  25
  26 : check-trash-path ( path -- )
  27     {
  28         [ file-info directory? ]
  29         [ sticky? ]
  30         [ link-info type>> +symbolic-link+ = not ]
  31     } 1&& [ "invalid trash path" throw ] unless ;
  32
  33 : trash-home ( -- path )
  34     "XDG_DATA_HOME" os-env
  35     home ".local/share" append-path or
  36     "Trash" append-path dup check-trash-path ;
  37
  38 : trash-1 ( root -- path )
  39     ".Trash" append-path dup check-trash-path
  40     real-user-id number>string append-path ;
  41
  42 : trash-2 ( root -- path )
  43     real-user-id ".Trash-%d" sprintf append-path ;
  44
  45 : trash-path ( path -- path' )
  46     top-directory dup trash-home top-directory = [
  47         drop trash-home
  48     ] [
  49         dup ".Trash" append-path exists?
  50         [ trash-1 ] [ trash-2 ] if
  51         [ make-user-directory ] keep
  52     ] if ;
  53
  54 : (safe-file-name) ( path counter -- path' )
  55     [
  56         [ parent-directory ]
  57         [ file-stem ]
  58         [ file-extension dup [ "." prepend ] when ] tri
  59     ] dip swap "%s%s %s%s" sprintf ;
  60
  61 : safe-file-name ( path -- path' )
  62     dup 0 [ over exists? ] [
  63         [ parent-directory to-directory ] [ 1 + ] bi*
  64         [ (safe-file-name) ] keep
  65     ] while drop nip ;
  66
  67 PRIVATE>
  68
  69 M: unix send-to-trash ( path -- )
  70     dup trash-path [
  71         "files" append-path [ make-user-directory ] keep
  72         to-directory safe-file-name
  73     ] [
  74         "info" append-path [ make-user-directory ] keep
  75         to-directory ".trashinfo" append [ over ] dip utf8 [
  76             "[Trash Info]" write nl
  77             "Path=" write write nl
  78             "DeletionDate=" write
  79             now "%Y-%m-%dT%H:%M:%S" strftime write nl
  80         ] with-file-writer
  81     ] bi move-file ;
  82
  83