diff --git a/Modules/wrappers.f90 b/Modules/wrappers.f90 index 0980fb5a6..2df2db53d 100644 --- a/Modules/wrappers.f90 +++ b/Modules/wrappers.f90 @@ -27,7 +27,7 @@ MODULE wrappers ! C std library functions fortran wrappers: PUBLIC f_remove, f_link, rename, f_chdir, f_mkdir, f_rmdir, f_getcwd ! more stuff: - PUBLIC feval_infix, md5_from_file, f_mkdir_safe + PUBLIC f_copy, feval_infix, md5_from_file, f_mkdir_safe ! ! HELP: ! integer f_remove(pathname) @@ -163,8 +163,28 @@ CONTAINS ENDDO output(i:)=' ' END SUBROUTINE - ! ! ==================================================================== + ! copy a file, uses clibs/copy.c which currently does a binary copy + ! using an 8kb buffer + ! + ! returns: + ! 0 : no error + ! -1 : cannot open source + ! -2 : cannot open dest + ! -3 : error while writing + ! -4 : disk full while writing + FUNCTION f_copy(source, dest) RESULT(r) + INTERFACE + FUNCTION c_copy(source,dest) BIND(C,name="copy") RESULT(r) + USE iso_c_binding + CHARACTER(kind=c_char),INTENT(in) :: source(*), dest(*) + INTEGER(c_int) :: r + END FUNCTION c_copy + END INTERFACE + CHARACTER(*),INTENT(in) :: source, dest + INTEGER(c_int) :: r + r= c_copy(TRIM(source)//C_NULL_CHAR, TRIM(dest)//C_NULL_CHAR) + END FUNCTION ! ! safe mkdir from clib/c_mkdir.c that creates a directory, if necessary, ! and checks permissions. It can be called in parallel. diff --git a/clib/Makefile b/clib/Makefile index d0460e8a8..eb4e56306 100644 --- a/clib/Makefile +++ b/clib/Makefile @@ -6,6 +6,7 @@ OBJS = \ customize_signals.o \ stack.o \ c_mkdir.o \ +copy.o \ cptimer.o \ eval_infix.o \ fft_stick.o \ diff --git a/clib/copy.c b/clib/copy.c new file mode 100644 index 000000000..80995f1f3 --- /dev/null +++ b/clib/copy.c @@ -0,0 +1,33 @@ + + +#include +#include + +int copy(const char* fn_in, const char* fn_out) { + + FILE *fd1 = fopen(fn_in, "r"); + if(!fd1) return -1; // cannot open input + + FILE *fd2 = fopen(fn_out, "w"); + if(!fd2) { // cannot open output + fclose(fd1); + return -2; + } + + size_t l1; + unsigned char buffer[8192]; + + while((l1 = fread(buffer, 1, sizeof buffer, fd1)) > 0) { + size_t l2 = fwrite(buffer, 1, l1, fd2); + if(l2 < 0 || l2 < l1) { + fclose(fd1); + fclose(fd2); + if(l2<0) return -3; // output error + return -4; // disk full + } + } + fclose(fd1); + fclose(fd2); + return 0; +} +