mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 15:43:01 +00:00 
			
		
		
		
	Add copyfile for copying large files.
This commit is contained in:
		| @@ -4011,6 +4011,17 @@ | |||||||
|                    (os/rmdir x))) |                    (os/rmdir x))) | ||||||
|     nil) |     nil) | ||||||
|  |  | ||||||
|  |   (defn- copyfile | ||||||
|  |     [from to] | ||||||
|  |     (def b (buffer/new 0x10000)) | ||||||
|  |     (with [ffrom (file/open from :rb)] | ||||||
|  |       (with [fto (file/open to :wb)] | ||||||
|  |         (forever | ||||||
|  |           (file/read ffrom 0x10000 b) | ||||||
|  |           (when (empty? b) (buffer/trim b) (break)) | ||||||
|  |           (file/write fto b) | ||||||
|  |           (buffer/clear b))))) | ||||||
|  |  | ||||||
|   (defn- sync-manifest |   (defn- sync-manifest | ||||||
|     [&opt manifest] |     [&opt manifest] | ||||||
|     (default manifest (dyn *bundle-manifest*)) |     (default manifest (dyn *bundle-manifest*)) | ||||||
| @@ -4066,6 +4077,7 @@ | |||||||
|   (defn bundle/install |   (defn bundle/install | ||||||
|     "Install a bundle from the local filesystem with a name `bundle-name`." |     "Install a bundle from the local filesystem with a name `bundle-name`." | ||||||
|     [path &opt bundle-name &keys config] |     [path &opt bundle-name &keys config] | ||||||
|  |     (def path (os/realpath path)) | ||||||
|     (default bundle-name (last (string/split "/" path))) |     (default bundle-name (last (string/split "/" path))) | ||||||
|     (assert (next bundle-name) "cannot use empty bundle-name") |     (assert (next bundle-name) "cannot use empty bundle-name") | ||||||
|     (assert (not (fexists (get-manifest-filename bundle-name))) |     (assert (not (fexists (get-manifest-filename bundle-name))) | ||||||
| @@ -4075,7 +4087,7 @@ | |||||||
|     (copy-hooks src-hooks bundle-name) |     (copy-hooks src-hooks bundle-name) | ||||||
|     (def man @{:bundle-name bundle-name :local-source path :config config}) |     (def man @{:bundle-name bundle-name :local-source path :config config}) | ||||||
|     (merge-into man config) |     (merge-into man config) | ||||||
|     (spit (get-manifest-filename bundle-name) (string/format "%j\n" man)) |     (sync-manifest man) | ||||||
|     (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) |     (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) | ||||||
|       (bundle/do-hook bundle-name "deps.janet") |       (bundle/do-hook bundle-name "deps.janet") | ||||||
|       (bundle/do-hook bundle-name "build.janet") |       (bundle/do-hook bundle-name "build.janet") | ||||||
| @@ -4104,7 +4116,7 @@ | |||||||
|           :directory (array/push install-source ~(bundle/add-directory ,relpath ,perm)) |           :directory (array/push install-source ~(bundle/add-directory ,relpath ,perm)) | ||||||
|           :file (do |           :file (do | ||||||
|                   (def filename (string/format "file_%04d" (++ i))) |                   (def filename (string/format "file_%04d" (++ i))) | ||||||
|                   (spit (string dest-dir "/" filename) (slurp file)) |                   (copyfile file (string dest-dir "/" filename)) | ||||||
|                   (array/push install-source ~(bundle/add-file ,filename ,relpath ,perm))) |                   (array/push install-source ~(bundle/add-file ,filename ,relpath ,perm))) | ||||||
|           (errorf "unexpected file %v" file))) |           (errorf "unexpected file %v" file))) | ||||||
|       (def b @"") |       (def b @"") | ||||||
| @@ -4113,7 +4125,7 @@ | |||||||
|     dest-dir) |     dest-dir) | ||||||
|  |  | ||||||
|   (defn bundle/reinstall |   (defn bundle/reinstall | ||||||
|     "Reinstall an existing bundle from the local source code. Should not break installation in reinstallation fails." |     "Reinstall an existing bundle from the local source code." | ||||||
|     [bundle-name] |     [bundle-name] | ||||||
|     (def manifest (bundle/manifest bundle-name)) |     (def manifest (bundle/manifest bundle-name)) | ||||||
|     (def path (get manifest :local-source)) |     (def path (get manifest :local-source)) | ||||||
| @@ -4153,7 +4165,7 @@ | |||||||
|       (def absdest (string (dyn *syspath*) "/" dest)) |       (def absdest (string (dyn *syspath*) "/" dest)) | ||||||
|       (when (os/stat absdest :mode) |       (when (os/stat absdest :mode) | ||||||
|         (errorf "collision at %s, file already exists" absdest)) |         (errorf "collision at %s, file already exists" absdest)) | ||||||
|       (spit absdest (slurp src)) |       (copyfile src absdest) | ||||||
|       (array/push files absdest) |       (array/push files absdest) | ||||||
|       (when chmod-mode |       (when chmod-mode | ||||||
|         (os/chmod absdest chmod-mode)) |         (os/chmod absdest chmod-mode)) | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose