/* unziparch.sas */

/*** HELP START ***//*
 
## >>> `%zipArch()` macro: <<< <a name="ziparch-macro"></a> #######################  

The zipArch() macro allows to ZIP content of a directory. 
Macro is OS-independent, the `XCMD` option is not required.

Content of zipped archive can be listed in the log.

Errors of decompression and are reported. 

Macro **does not** include hidden files.

See examples below for the details.

### SYNTAX: ###################################################################

The basic syntax is the following, the `<...>` means optional parameters:
~~~~~~~~~~~~~~~~~~~~~~~sas
%zipArch(
    archName
   ,path = 
  <,pathRef=>
  <,target=>
  <,targetRef=>
  <,list=>
  <,overwrite=>
  <,dropList=> 
)
~~~~~~~~~~~~~~~~~~~~~~~

**Arguments description**:

1. `archName`      - *Required*, name of the archive to be generated.
                     Name should be full, i.e., with the extension!

2. `path=`         - *Required/Optional*, location of a directory to ZIP.
                     The path should be provided unquoted.
                     Has priority over the `pathRef` parameter.

* `pathRef=`       - *Required/Optional*, fileref to location of a directory to ZIP.
                     The reference **has** to be pointing to single directory.
                     If provided with `path` - the `path` takes 
                     priority over the `pathRef` parameter.

* `target=`        - *Optional*, a path pointing to target location where
                     the archive will be generated.
                     The path should be provided unquoted.
                     Default value is `WORK` location.
                     Has priority over the `targetRef` parameter.

* `targetRef=`     - *Optional*, fileref to a path pointing to target location 
                     where the archive will be generated.
                     The reference **has** to be pointing to single directory.
                     If provided with `target` - the `target` takes 
                     priority over the `targetRef` parameter.

* `list = 0`       - *Optional*, default value is `0`,
                     indicates if zip content should be listed in the log. 
                     `1` means *yes*, `0` means *no*. 

* `overwrite = 0`  - *Optional*, default value is `0`,
                     indicates if existing archive file should be overwritten. 
                     `1` means *yes*, `0` means *no*. 

* `overwrite = 1`  - *Technical*, default value is `1`,
                     indicates if the "to-be-zipped-files-list" 
                     data set should be deleted. 
                     `1` means *yes*, `0` means *no*.

---

*//*** HELP END ***/

%macro zipArch(
  archName /* name of a ZIP file (WITH! extension) */

, path = /* location of a directory to ZIP */
, pathRef = /* fileref to location of a directory to ZIP */

, target = /* a path in which the content will be ZIPped,
              default location is SAS work */
, targetRef = /* fileref to a path in which the content will be ZIPped */

, list = 0 /* indicates should archived data be listed */
, overwrite = 0 /* indicates if existing archive be overwritten */
, dropList = 1 /* indicates if "to be zipped files list" data set should be deleted */
)
/
secure des = 'Macro to zip a directory.'
;
%local zip list2ZIP time;
%let zip = zip;
%let list2ZIP = WORK.__list2ZIP__%sysfunc(datetime(),B8601dt15.)__;
%let time = %sysfunc(datetime());

/* %put &=list2ZIP.; */

%if %superq(path)= %then
  %do;
    %if %superq(pathRef)= %then
      %do;
        %let path = %sysfunc(pathname(WORK))/#DOES#NOT#EXIST#;
        %put ERROR:[&sysmacroname.] Parameters PATH and PATHREF are empty!;
        %put ERROR-[&sysmacroname.] Exiting!;
        %goto EndOFMacro_zipArch;
      %end;
    %else
      %let path = %sysfunc(pathname(%superq(pathRef)));
  %end;

%if %superq(target)= %then
  %do;
    %if %superq(targetRef)= %then
      %do;
        %let target = %sysfunc(pathname(WORK));
        %put NOTE:[&sysmacroname.] Parameters TARGET and TARGETREF are empty!;
        %put NOTE-[&sysmacroname.] The WORK library location will be used.;
      %end;
    %else
      %let target = %sysfunc(pathname(%superq(targetRef)));
  %end;

%local pathExist targetExist;
%let pathExist = %sysfunc(FILEEXIST(%superq(path)));
%let targetExist = %sysfunc(FILEEXIST(%superq(target)));

%if &pathExist. AND &targetExist. %then
  %do;
    /* check if a file exists in the target directory*/

    %local tmp_options;
    %let tmp_options = 
      %sysfunc(getoption(notes))
      %sysfunc(getoption(stimer))
      %sysfunc(getoption(fullstimer))
      %sysfunc(getoption(source))
      msglevel=%sysfunc(getoption(msglevel))
      ;
    options nonotes nostimer nofullstimer nosource msglevel=N;
    %local delError createPackageContentStatus;
    %let delError = 0;
    %let createPackageContentStatus = 0;

    data _null_;
      length 
        TrgtRef $ 8
        target $ 8192 
        archName $ 256 
      ;
      target = dequote(symget('target'));
      archName = dequote(symget('archName'));
      overwrite = input(symget('overwrite'),?? best32.);

      rc1 = filename(TrgtRef, catx("/", target, archName));
      /* rctxt = sysmsg(); put _all_; */
      if fexist(TrgtRef) then
        do;
          if overwrite = 1 then
            do;
              if fdelete(TrgtRef) NE 0 then
                do;
                  put "ERROR:[&sysmacroname.] The " archName "file already exist and cannot be deleted!";
                  put "ERROR-[&sysmacroname.] Delete the file from " target "directory and try again.";
                  call symputx('delError', 1, 'l');
                end;
            end;
          else
            do;
              put "ERROR:[&sysmacroname.] The " archName "file already exist!";
              put "ERROR-[&sysmacroname.] Delete the file from " target "directory and try again";
              put "ERROR-[&sysmacroname.] or set OVERWRITE parameter to 1";
              call symputx('delError', 1, 'l');           
            end;        
        end;
      rc1 = filename(TrgtRef); /* rctxt = sysmsg(); put _all_; */
    run;
    options &tmp_options.;
    %if &delError. %then 
      %goto EndOFMacro_zipArch;
    
    options nonotes nostimer nofullstimer nosource msglevel=N;

    /* this part of the code is inspired by Kurt Bremser's "Talking to Your Host" article */
    /* https://communities.sas.com/t5/SAS-User-Groups-Library/WUSS-Presentation-Talking-to-Your-Host/ta-p/838344 */
    /* WUSS 2022 */
    /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
    data &list2ZIP.;
    run;

    data &list2ZIP.(compress=yes);
      length root dname $ 8192 filename $ 256 dir level 8;
      root = dequote(symget('path'));
      retain filename dname ' ' level 0 dir 1;
      label 
        filename = "file"
        dname = "folder"
        ;
    run;

    data &list2ZIP.;
      modify &list2ZIP.;
      length tmp $ 8;
      rc1=filename(tmp,catx('/',root,dname,filename));
      rc2=dopen(tmp);
      dir = 1 & rc2;
      if dir then 
        do;
          dname=catx('/',dname,filename);
          filename=' ';
        end;
      replace;

      if dir;

      level=level+1;

      do i=1 to dnum(rc2);
        filename=dread(rc2,i);
        output;
      end;
      rc3=dclose(rc2);
    run;

    proc sort 
      data=&list2ZIP.(where=(filename is not null))
      out=&list2ZIP.(compress=yes)
      ;
      by root dname filename;
    run;
    /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/

    data _null_;
      length 
        _SPFIN_ _SPFOUT_ $ 8
        target $ 8192 
        archName $ 256 
      ;
      target = dequote(symget('target'));
      archName = dequote(symget('archName'));
      list = input(symget('list'),?? best32.);

      if _N_ = 1 then
        put "INFO:[&sysmacroname.] " nobs "files to be zipped.";
      if end = 1 then
        do;
          if symgetn('createPackageContentStatus') = 0 then
            put "INFO:[&sysmacroname.] Archive " archName "is located in " target "directory.";
          if problem then
            put "WARNING:[&sysmacroname.] " problem "problem(s) occured.";
        end;

      set &list2ZIP. nobs=nobs end=end;
      if dir=0;

      rc1=filename(_SPFIN_ , catx('/',root,dname,filename), "disk", "lrecl=1 recfm=n");
      length rc1txt $ 8192;
      rc1txt=sysmsg();
      rc2=filename(_SPFOUT_, catx("/", target, archName), "ZIP"
                  ,"lrecl=1 recfm=n member='" !! catx('/',dname,filename) !! "'");
      length rc2txt $ 8192;
      rc2txt=sysmsg();

      do _I_ = 1 to 10;
        rc3=fcopy(_SPFIN_,_SPFOUT_);
        length rc3txt $ 8192;
        rc3txt=sysmsg();
        if fexist(_SPFOUT_) then leave;
        else sleeprc=sleep(0.25,1);
      end;

      rc4=fexist(_SPFOUT_);
      length rc4txt $ 8192;
      rc4txt=sysmsg();

      problem + (rc4 = 0);
      if problem then
        do;
          call symputX("createPackageContentStatus",1,"L");
          put "ERROR: [&sysmacroname.]" @;
        end;
      if (list or problem) then
        put "Element: " dname +(-1) "/" filename ;
      if problem then 
        put "Try=" _I_ "Return codes:" / 
            (rc:) (=);

      rc1=filename(_SPFIN_);
      rc2=filename(_SPFOUT_);
    run;

    %if %superq(dropList) = 1 %then
      %do;
        proc delete data=&list2ZIP.;
        run;
      %end;

    options &tmp_options.;

  %end;
%else
  %do;
      %if 0 = &pathExist. %then
        %put ERROR:[&sysmacroname.] Path does not exist!;
      %if 0 = &targetExist. %then
        %put ERROR:[&sysmacroname.] Target does not exist!;
      %put ERROR-[&sysmacroname.] Exiting!;
  %end;

  %if &createPackageContentStatus. %then
    %do;
      %put ERROR:[&sysmacroname.] Errors occured while zippping data!;
      %put ERROR-[&sysmacroname.] Check the log!;
    %end;

%put NOTE:[&sysmacroname.] Processing time: %sysfunc(abs(%sysfunc(datetime()) - &time.), time8.).;

%EndOFMacro_zipArch:
%mend zipArch;

/*** HELP START ***//*

### EXAMPLES AND USECASES: ####################################################

**EXAMPLE 1.** Zip a directory . Example requires the `basePlus` package.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~sas

options dlCreateDir;
libname arch1 "%workPath()/testArch1";
libname arch2 "%workPath()/testArch2";

filename arch1 "%workPath()/testArch1";

data _null_;
  file arch1(test1.txt);
  put "text for test file 1";
data _null_;
  file arch1(test2.txt);
  put "text for test file 2";
data _null_;
  file arch1(test3.txt);
  put "text for test file 3";
run;

data arch1.class(index=(name));
  set sashelp.class;
run;
data arch1.cars(index=(model));
  set sashelp.cars;
run;



%zipArch(
  archName1.zip
, path = %workPath()/testArch1
, list = 1 
, overwrite = 1

)

%zipArch(
  archName2.zip
, pathRef = arch1
, target = %workPath()/testArch2
, list = 1 
, overwrite = 1
)


%unzipArch(
  archName2.zip 
, path = %workPath()/testArch2
, target = %workPath()/testArch2
, clean=1
, list=1
);

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

---

*//*** HELP END ***/

/**###################################################################**/
/*                                                                     */
/*  Copyright Bartosz Jablonski, since 2023.                           */
/*                                                                     */
/*  Code is under the MIT license. If you want - you can use it.       */
/*  But it comes with absolutely no warranty whatsoever.               */
/*  If you cause any damage or something - it will be your own fault.  */
/*  You've been warned! You are using it on your own risk.             */
/*  However, if you decide to use it don't forget to mention author.   */
/*  Bartosz Jablonski (yabwon@gmail.com)                               */
/*                                                                     */
/**###################################################################**/
