abstract [Files handling (listing, copying, ...)] ; eol
# Copyright Hubert Tonneau hubert.tonneau@pliant.cx # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License version 2 # as published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # version 2 along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
submodule "/pliant/language/stream/filebase1.pli" submodule "/pliant/language/stream/filebase2.pli" module "/pliant/language/stream.pli" module "/pliant/language/stream/filesystembase.pli" module "/pliant/language/os.pli"
constant trace false constant advanced_tmp false
if os_api="linux" or os_api="posix" if advanced_tmp gvar Sem temp_sem ; gvar Str temp_path ; gvar Int temp_counter
function file_configure filename options command -> status arg Str filename options command ; arg ExtendedStatus status status := pliant_default_file_system configure filename options command
function file_configure filename command -> status arg Str filename command ; arg ExtendedStatus status status := file_configure filename "" command
export file_configure
#----------------------------------------------------------------------
function file_tree_create filename -> status arg Str filename ; arg Status status var Str path := filename 0 (filename search_last "/" -1)+1 if (file_query path standard+directories)=defined status := success eif path<>"" status := shunt (file_tree_create (path 0 path:len-1))=success and (file_configure path "mkdir")=success success failure else status := failure
#--------------------------------------------------------------------------
function file_delete filename -> status arg Str filename ; arg ExtendedStatus status if filename:len>0 and (filename filename:len-1)="/" status := file_configure (filename 0 filename:len-1) "delete" if status=failure status := file_configure filename "rmdir" else status := file_configure filename "delete" if os_api="linux" or os_api="posix" if advanced_tmp temp_sem request if temp_path:len<>0 and (filename 0 temp_path:len)=temp_path if (os_rmdir (temp_path 5 temp_path:len))=0 temp_path := "" temp_sem release
function file_link src dest force -> status arg Str src dest ; arg CBool force ; arg ExtendedStatus status var Str target := (file_query src extended):options option "os_name" Str if target<>"" status := file_configure dest "link "+string:target+(shunt force " force" "") eif (target search "/" -1)=(-1) status := file_configure dest "link "+string:src+(shunt force " force" "") else status := failure
function file_link src dest -> status arg Str src dest ; arg Status status status := file_link src dest false
function file_clone src dest force -> status arg Str src dest ; arg CBool force ; arg ExtendedStatus status var Str target := (file_query dest extended):options option "os_name" Str if target<>"" status := file_configure src "clone "+string:target+(shunt force " force" "") else status := failure
function file_clone src dest -> status arg Str src dest ; arg ExtendedStatus status status := file_clone src dest false
module "/pliant/language/stream/listmode.pli" module "/pliant/language/compiler.pli"
|
constant use_sendfile false # os_api="linux"
if use_sendfile function os_sendfile64 out_fd in_fd offset count -> copied arg Int out_fd in_fd ; arg_rw Int64 offset ; arg Int count copied kernel_function 239
|
function file_copy src dest flags -> status arg FileInfo src dest ; arg Int flags ; arg ExtendedStatus status check (flags .and. recursive)=0 check (flags .and. delete)=0 or (flags .and. bidirectional)=0 check src:datetime=defined or dest:datetime=defined or (flags .and. (lazy .or. newer .or. bidirectional))=0 if (flags .and. bidirectional)<>0 if dest=defined and (src=undefined or (src:datetime=defined and dest:datetime=defined and dest:datetime>src:datetime)) return (file_copy dest src flags) if (flags .and. (newer .or. bidirectional))<>0 if src:datetime=defined and dest:datetime=defined and dest:datetime>=src:datetime return success if (flags .and. lazy)<>0 if dest:datetime=src:datetime and dest:size=src:size return success var Str cmd if (flags .and. level_flags)>=standard and src:datetime=defined src:datetime split (var Int year) (var Int month) (var Int day) (var Int hour) (var Int minute) (var Int second) (var Float fraction) cmd := "datetime "+string:year+"/"+string:month+"/"+string:day+" "+string:hour+":"+string:minute+":"+string:second else cmd := "" cmd += (shunt cmd<>"" " " "")+"file_size "+(string src:size) if (flags .and. level_flags)>=extended and src:options<>"" cmd += (shunt cmd<>"" " " "")+src:options if src:is_link and (flags .and. linktransparent)=0 if ((dest:options option "link" Str)=(src:options option "link" Str)) return success if (file_configure dest:name "link "+string:(src:options option "link" Str)+" force")=success return success file_tree_create dest:name return (file_configure dest:name "link "+string:(src:options option "link" Str))
|
eif src:is_directory
|
eif src:is_directory and (flags .and. forcefile)=0
|
if dest=defined and dest:is_directory status := success else status := file_tree_create dest:name else var Stream s ; s open src:name in+safe+bigcache if s=failure return failure var Stream d ; d open dest:name cmd out+mkdir+safe+bigcache if d=failure return failure var Intn total := 0
|
while { var Int step := raw_copy s d 1 2^30 ; step>0 } total += step
|
if use_sendfile and s:stream_handle<>undefined and d:stream_handle<>undefined while { var Int step := os_sendfile64 d:stream_handle s:stream_handle (null map Int64) 2^16 ; step>0 } total += step if not use_sendfile or total=0 while { var Int step := raw_copy s d 1 2^30 ; step>0 } total += step
|
if (flags .and. level_flags)<standard status := success eif (s safe_query "encoding")<>"" or (d safe_query "encoding")<>"" status := success else status := shunt total=src:size success failure if d:close=failure # let's close the destination first as a workaround Linux stalled connections on close when using NAT status := failure if s:close=failure status := failure if cmd<>"" file_configure dest:name cmd if trace console src:name+" -> "+dest:name+(shunt status=success " success" " failure")+"[lf]"
function file_copy src dest flags -> status arg Str src dest ; arg Int flags ; arg ExtendedStatus status status := file_copy (file_query src extended) (file_query dest extended) flags
(the_function file_copy FileInfo FileInfo Int -> ExtendedStatus) extra_module :> the_module "/pliant/language/stream/listmode.pli" (the_function file_copy Str Str Int -> ExtendedStatus) extra_module :> the_module "/pliant/language/stream/listmode.pli"
function file_copy src dest -> status arg Str src dest ; arg ExtendedStatus status status := file_copy src dest extended
function file_move oldfilename newfilename -> status arg Str oldfilename newfilename ; arg ExtendedStatus status if newfilename=oldfilename return success var Str target := (file_query newfilename extended):options option "os_name" Str if target<>"" if (file_configure oldfilename "move "+string:target)=success return success status := file_copy oldfilename newfilename if status=success and newfilename<>oldfilename file_delete oldfilename
function mode u g o -> m arg Int u g o m m := u*8^2+g*8+o
function file_rights info owner group on off arg FileInfo info ; arg Int owner group on off var Int m := info:options option "mode" Int var Int m2 := (m .and. .not. off) .or. on if (shunt owner=defined (info:options option "uid" Int)<>owner false) or (shunt group=defined (info:options option "gid" Int)<>group false) or m2<>m file_configure info:name (shunt owner=defined "uid "+string:owner "")+" "+(shunt group=defined "gid "+string:group "")+" "+(shunt m2<>m "mode "+string:m2 "") # console "setting access rights for " info:name eol
function file_rights filename owner group on off arg Str filename ; arg Int owner group on off file_rights (file_query filename extended) owner group on off
function file_directory_flush filename -> status arg Str filename ; arg ExtendedStatus status var Str path := filename 0 (filename search_last "/" -1) status := file_configure path "flush"
#----------------------------------------------------------------------
function file_tree_delete path -> status arg Str path ; arg ExtendedStatus status var Array:FileInfo subs := file_list path extended+directories+deadlinks for (var Int i) 0 subs:size-1 if subs:i:is_directory and not subs:i:is_link file_tree_delete subs:i:name else file_delete subs:i:name status := file_delete path
function file_name_concat path subpath -> fullpath arg Str path subpath fullpath if path:len>0 and path:0="[dq]" and (path parse (var Str strippedpath) any:(var Str options)) fullpath := (string strippedpath+subpath)+(shunt options<>"" " " "")+options else fullpath := path+subpath
function file_tree_copy src dest flags -> status arg Str src dest ; arg Int flags ; arg ExtendedStatus status check (flags .and. delete)=0 or (flags .and. bidirectional)=0 check src<>"" and (src src:len-1)="/" and dest<>"" and (dest dest:len-1)="/" status := success var Array:FileInfo src_files := file_list src extended+recursive+relative for (var Int i) 0 src_files:size-1 var FileInfo srci := src_files i ; srci name := file_name_concat src srci:name var FileInfo desti := file_query (file_name_concat dest src_files:i:name) extended if (file_copy srci desti flags)=failure status := failure if (flags .and. (bidirectional .or. delete))<>0 var Array:FileInfo dest_files := file_list dest extended+recursive+relative for (var Int i) 0 dest_files:size-1 var FileInfo desti := dest_files i ; desti name := file_name_concat dest desti:name var FileInfo srci := file_query (file_name_concat src dest_files:i:name) extended if srci=undefined if (flags .and. bidirectional)<>0 if (file_copy desti srci flags)=failure status := failure else check (flags .and. delete)<>0 if (file_delete desti:name)=failure status := failure (the_function file_tree_copy Str Str Int -> ExtendedStatus) extra_module :> the_module "/pliant/language/stream/listmode.pli"
function file_tree_copy src dest -> status arg Str src dest ; arg ExtendedStatus status status := file_tree_copy src dest extended
function file_tree_rights path owner group files_on files_off dirs_on dirs_off arg Str path ; arg Int owner group files_on files_off dirs_on dirs_off var Array:FileInfo files := file_list path extended+recursive+directories for (var Int i) 0 files:size-1 if files:i:is_directory file_rights files:i owner group dirs_on dirs_off else file_rights files:i owner group files_on files_off file_rights path owner group dirs_on dirs_off
function file_tree_cleanup path arg Str path check path<>"" and (path path:len-1)="/" var Array:FileInfo subs := file_list path extended+directories for (var Int i) 0 subs:size-1 if subs:i:is_directory and not subs:i:is_link file_tree_cleanup subs:i:name file_delete path
#--------------------------------------------------------------------------
if os_api="linux" or os_api="posix"
if advanced_tmp
function file_temporary -> name arg Str name temp_sem request var Int try_count := 0 while temp_path="" temp_path := "file:/tmp/pliant"+string:os_getpid+"_"+string:try_count+"/" temp_counter := 0 if (os_mkdir (temp_path 5 temp_path:len) 7*8^2)<>0 temp_path := "" ; try_count += 1 temp_counter += 1 name := temp_path+string:temp_counter+".tmp" temp_sem release function file_temporary_cleanup if (file_query "file:/proc/" standard)=defined var Array:FileInfo files := file_list "file:/tmp/" standard+directories (var Relation processes) flags := 0 var Array:FileInfo proc := file_list "file:/proc/" standard for (var Int i) 0 proc:size-1 if (proc:i:name parse "file:/proc/" (var Int pid) "/") processes define (cast pid Address) null (cast -1 Address) for (var Int i) 0 files:size-1 if (files:i:name parse "file:/tmp/pliant" (var Int pid) "_" any "/") if (processes query (cast pid Address) null)=null file_tree_delete files:i:name function reset_temporary parameter filehandle arg Address parameter ; arg Int filehandle temp_path := "" gvar DelayedAction da da function :> the_function reset_temporary Address Int pliant_restore_actions append addressof:da
else
gvar Sem temp_sem gvar Int temp_counter := 0 function file_temporary -> name arg Str name part generate_name temp_sem request temp_counter += 1 name := "file:/tmp/pliant_"+string:os_getpid+"_"+string:temp_counter+".tmp" temp_sem release if (file_query name standard)=defined file_delete name restart generate_name
function file_temporary_cleanup void
eif os_api="win32"
gvar Sem temp_sem gvar Int temp_counter := 0
function file_temporary -> name arg Str name temp_sem request var Str tmp := os_environment_variable "TMP" if tmp:len=0 tmp := os_environment_variable "TEMP" if tmp:len=0 tmp := "c:\temp" temp_counter += 1 name := "file:"+(replace tmp "\" "/")+"/pliant_"+string:os_getpid+"_"+string:temp_counter+".tmp" temp_sem release
function file_temporary_cleanup void
eif os_api="os2"
gvar Sem temp_sem gvar Int temp_counter := 0
function file_temporary -> name arg Str name temp_sem request temp_counter += 1 name := "file:c:/tmp/pliant_"+string:os_getpid+"_"+string:temp_counter+".tmp" temp_sem release
function file_temporary_cleanup void
function file_temporary filename options -> temp arg Str filename options temp if (options option "notmp") return filename var Str temp0 if (temp eparse (var Str base) any:(var Str opt)) temp0 := string:(file_temporary base options)+opt else temp0 := filename+".tmp" var Int counter := 0 part checkit temp := temp0+(shunt counter=0 "" string:counter) if (file_query temp standard)=defined counter += 1 restart checkit
function file_os_name filename -> osname arg Str filename osname osname := (file_query filename extended):options option "os_name" Str
function file_hook filename arg Str filename plugin hook
#--------------------------------------------------------------------------
export file_delete file_link file_clone file_copy file_move file_rights file_directory_flush export file_tree_create file_tree_delete file_tree_copy file_tree_rights file_tree_cleanup export file_temporary file_temporary_cleanup file_os_name file_hook
|