|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-cp-p.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: Support for preserving file modtimes with copies. i.e. cp -p
|
|
|
9 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
10 ;; Created: Fri Feb 18 03:28:22 1994 by sandy on ibm550
|
|
|
11 ;; Modified: Sun Nov 27 12:17:33 1994 by sandy on gandalf
|
|
|
12 ;; Language: Emacs-Lisp
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;;; This file is part of efs. See efs.el for copyright
|
|
|
17 ;;; (it's copylefted) and warrranty (there isn't one) information.
|
|
|
18
|
|
|
19 (provide 'efs-cp-p)
|
|
|
20 (require 'efs)
|
|
|
21
|
|
|
22 ;;;; Internal Variables
|
|
|
23
|
|
|
24 (defconst efs-cp-p-version
|
|
|
25 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
26 "/"
|
|
|
27 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
28
|
|
|
29 (defvar efs-local-timezone nil)
|
|
|
30 ;; cache.
|
|
|
31
|
|
|
32 ;;; Utility functions
|
|
|
33
|
|
|
34 (efs-define-fun efs-gmt-time ()
|
|
|
35 ;; Get the time as the number of seconds elapsed since midnight,
|
|
|
36 ;; Jan 1, 1970, GMT. Emacs 18 doesn't have `current-time' function.
|
|
|
37 (let ((time (current-time)))
|
|
|
38 (list (car time) (nth 1 time))))
|
|
|
39
|
|
|
40 (defun efs-local-time ()
|
|
|
41 (let ((str (current-time-string)))
|
|
|
42 (efs-seconds-elapsed
|
|
|
43 (string-to-int (substring str -4))
|
|
|
44 (cdr (assoc (substring str 4 7) efs-month-alist))
|
|
|
45 (string-to-int (substring str 8 10))
|
|
|
46 (string-to-int (substring str 11 13))
|
|
|
47 (string-to-int (substring str 14 16))
|
|
|
48 0))) ; don't care about seconds
|
|
|
49
|
|
|
50 (defun efs-local-timezone ()
|
|
|
51 ;; Returns the local timezone as an integer. Right two digits the minutes,
|
|
|
52 ;; others the hours.
|
|
|
53 (or efs-local-timezone
|
|
|
54 (setq efs-local-timezone
|
|
|
55 (let* ((local (efs-local-time))
|
|
|
56 (gmt (efs-gmt-time))
|
|
|
57 (sign 1)
|
|
|
58 (diff (efs-time-minus local gmt))
|
|
|
59 hours minutes)
|
|
|
60 ;; 2^16 is 36 hours.
|
|
|
61 (if (zerop (car diff))
|
|
|
62 (setq diff (nth 1 diff))
|
|
|
63 (error "Weird timezone!"))
|
|
|
64 (setq diff (/ (- (nth 1 local) (nth 1 gmt)) 60))
|
|
|
65 (setq hours (/ diff 60))
|
|
|
66 (setq minutes (% diff 60))
|
|
|
67 (if (< diff 0)
|
|
|
68 (setq sign -1
|
|
|
69 hours (- hours)
|
|
|
70 minutes (- minutes)))
|
|
|
71 ;; Round minutes
|
|
|
72 (setq minutes (* 10 (/ (+ minutes 5) 10)))
|
|
|
73 (if (= minutes 60)
|
|
|
74 (setq hours (1+ hours)
|
|
|
75 minutes 0))
|
|
|
76 (* sign (+ (* hours 100) minutes))))))
|
|
|
77
|
|
|
78 (defun efs-last-day-of-month (month year)
|
|
|
79 ;; The last day in MONTH during YEAR.
|
|
|
80 ;; Taken from calendar.el. Thanks.
|
|
|
81 (if (and
|
|
|
82 (or
|
|
|
83 (and (= (% year 4) 0)
|
|
|
84 (/= (% year 100) 0)) ; leap-year-p
|
|
|
85 (= (% year 400) 0))
|
|
|
86 (= month 2))
|
|
|
87 29
|
|
|
88 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
|
|
|
89
|
|
|
90 (defun efs-make-date-local (year month day hour minutes seconds)
|
|
|
91 ;; Takes a GMT date (list of integers), and returns the local time.
|
|
|
92 (let* ((lzone (efs-local-timezone))
|
|
|
93 (lminutes (% lzone 100))
|
|
|
94 (lhour (/ lzone 100)))
|
|
|
95 (setq minutes (+ minutes lminutes))
|
|
|
96 (cond ((> minutes 60)
|
|
|
97 (setq minutes (- minutes 60)
|
|
|
98 hour (1+ hour)))
|
|
|
99 ((< minutes 0)
|
|
|
100 (setq minutes (+ minutes 60)
|
|
|
101 hour (1- hour))))
|
|
|
102 (setq hour (+ lhour hour))
|
|
|
103 (if (or (< hour 0) (> hour 23))
|
|
|
104 (progn
|
|
|
105 (cond ((< hour 0)
|
|
|
106 (setq hour (+ hour 24)
|
|
|
107 day (1- day)))
|
|
|
108 ((> hour 23)
|
|
|
109 (setq hour (- hour 24)
|
|
|
110 day (1+ day))))
|
|
|
111 (if (or (zerop day) (> day
|
|
|
112 (efs-last-day-of-month month year)))
|
|
|
113 (cond ((zerop day)
|
|
|
114 (setq month (1- month))
|
|
|
115 (if (zerop month)
|
|
|
116 (setq year (1- year)
|
|
|
117 month 12))
|
|
|
118 (setq day (efs-last-day-of-month month year)))
|
|
|
119 ((> day (efs-last-day-of-month month year))
|
|
|
120 (setq month (1+ month)
|
|
|
121 day 1)
|
|
|
122 (if (= month 13)
|
|
|
123 (setq year (1+ year)
|
|
|
124 month 1)))))))
|
|
|
125 (list year month day hour minutes seconds)))
|
|
|
126
|
|
|
127 ;;;; Entry function
|
|
|
128
|
|
|
129 (defun efs-set-mdtm-of (filename newname &optional cont)
|
|
|
130 ;; NEWNAME must be local
|
|
|
131 ;; Always works NOWAIT = 0
|
|
|
132 (let* ((parsed (efs-ftp-path filename))
|
|
|
133 (host (car parsed))
|
|
|
134 (user (nth 1 parsed))
|
|
|
135 (file (nth 2 parsed)))
|
|
|
136 (if (efs-get-host-property host 'mdtm-failed)
|
|
|
137 (and cont (efs-call-cont cont 'failed "" "") nil)
|
|
|
138 (efs-send-cmd
|
|
|
139 host user
|
|
|
140 (list 'quote 'mdtm file)
|
|
|
141 nil nil
|
|
|
142 (efs-cont (result line cont-lines) (host newname cont)
|
|
|
143 (if (or result
|
|
|
144 (not (string-match efs-mdtm-msgs line)))
|
|
|
145 (efs-set-host-property host 'mdtm-failed t)
|
|
|
146 (let ((time (apply 'efs-make-date-local
|
|
|
147 (mapcar 'string-to-int
|
|
|
148 (list
|
|
|
149 (substring line 4 8)
|
|
|
150 (substring line 8 10)
|
|
|
151 (substring line 10 12)
|
|
|
152 (substring line 12 14)
|
|
|
153 (substring line 14 16)
|
|
|
154 (substring line 16 18))))))
|
|
|
155 (if time
|
|
|
156 (call-process "touch" nil 0 nil "-t"
|
|
|
157 (format "%04d%02d%02d%02d%02d.%02d"
|
|
|
158 (car time) (nth 1 time)
|
|
|
159 (nth 2 time) (nth 3 time)
|
|
|
160 (nth 4 time) (nth 5 time))
|
|
|
161 newname))))
|
|
|
162 (if cont (efs-call-cont cont result line cont-lines)))
|
|
|
163 0))))
|
|
|
164
|
|
|
165 ;;; end of efs-cp-p.el
|
