1% * -*- Mode: Prolog -*- */
    2
    3:- module(sync,
    4          [
    5	      sync_remote_to_cwd/2,
    6	      sync_remote_to_dir/2,
    7	      sync_dir_to_remote/2
    8          ]).    9
   10:- use_module(library(biomake/biomake)).   11
   12% ----------------------------------------
   13% SYNC TO/FROM REMOTE STORAGE
   14% ----------------------------------------
   15
   16sync_remote_to_cwd(Dir,Opts) :-
   17    working_directory(Cwd,Cwd),
   18    absolute_file_name(Cwd,Dir),
   19    sync_remote_to_dir(Dir,Opts).
   20
   21sync_remote_to_dir(Dir,Opts) :-
   22    get_opt(sync,URI,Opts),
   23    !,
   24    sync_exec(Exec,URI,Opts),
   25    ends_with_slash(URI,URISlash),
   26    ends_with_slash(Dir,DirSlash),
   27    verbose_report('Syncing from ~w to ~w',[URISlash,DirSlash],Opts),
   28    format(string(SyncCmd),"~w ~w ~w",[Exec,URISlash,DirSlash]),
   29    shell(SyncCmd).
   30
   31sync_remote_to_dir(_Dir,_Opts).
   32
   33sync_dir_to_remote(Dir,Opts) :-
   34    get_opt(sync,URI,Opts),
   35    !,
   36    sync_exec(Exec,URI,Opts),
   37    ends_with_slash(URI,URISlash),
   38    ends_with_slash(Dir,DirSlash),
   39    verbose_report('Syncing from ~w to ~w',[DirSlash,URISlash],Opts),
   40    format(string(SyncCmd),"~w ~w ~w",[Exec,DirSlash,URISlash]),
   41    shell(SyncCmd).
   42
   43sync_dir_to_remote(_Dir,_Opts).
   44
   45ends_with_slash(S,S) :- string_concat(_,"/",S), !.
   46ends_with_slash(S,Ss) :- string_concat(S,"/",Ss).
   47
   48sync_exec(Exec,_URI,Opts) :-
   49    get_opt(sync_exec,Exec,Opts),
   50    !.
   51
   52sync_exec(Exec,URI,_Opts) :-
   53    string_concat("s3://",_,URI),
   54    s3_sync_exec(Exec),
   55    !.
   56
   57sync_exec(Exec,_URI,_Opts) :-
   58    rsync_exec(Exec).
   59
   60s3_sync_exec("aws s3 sync --delete").
   61
   62rsync_exec("rsync -r --delete")