%* Deprecated;

/*-----
 * group: Data out
 * purpose: Deprecated, replaced by <a href="?m=sas2xls">sas2xls<a>.<BR>Export up to fifty SAS datasets and/or SOURCE catalog entries as worksheets of an Excel file.<BR>This macro can write to _WEBOUT to deliver real Excel worksheets from SAS/Intrnet applications
 * notes: Requires Perl and module Spreadsheet::WriteExcel.<BR>Thanks to John McNamara @ cpan.org for answering my questions, his great module makes writing a binary Excel file easy.<BR>A <A HREF="http://groups.google.com/groups?q=author%3Axlr82sas@aol.com+%22Bidirectional+Named+Pipe+Communications+between+PERL+and+SAS+%22">Roger DeAngelis post</A> to SAS-L got me started on this.
 */

/**html
 * <a href="~sas2xls-test.sas">Test code</a> can be found here.
 */

%macro sas2xls (
  file=
, fileref=
, sheet1=,  sheet2=,  sheet3=,  sheet4=,  sheet5=,  sheet6=,  sheet7=,  sheet8=,  sheet9=,  sheet10=
, sheet11=, sheet12=, sheet13=, sheet14=, sheet15=, sheet16=, sheet17=, sheet18=, sheet19=, sheet20=
, sheet21=, sheet22=, sheet23=, sheet24=, sheet25=, sheet26=, sheet27=, sheet28=, sheet29=, sheet30=
, sheet31=, sheet32=, sheet33=, sheet34=, sheet35=, sheet36=, sheet37=, sheet38=, sheet39=, sheet40=
, sheet41=, sheet42=, sheet43=, sheet44=, sheet45=, sheet46=, sheet47=, sheet48=, sheet49=, sheet50=
, perl= perl -w
, tempdir= %sysfunc (pathname(WORK))
);

  %*
  %* sas2xls - Use Perl to create an excel file containing one worksheet per SAS dataset
  %*
  %* Richard A. DeVenezia
  %* 5/20/02
  %*
  %* This macro does not attempt to handle formatting issues.
  %* We will have to wait for SAS to get off their duff and write an
  %* ODS EXCEL destination.
  %*
  %* Perl Host requirements:
  %*   Perl 5.005 (or later)
  %*   Spreadsheet::WriteExcel
  %*   Parse::RecDescent
  %*   File::Temp
  %*
  %* Assumptions:
  %*   Perl and SAS are installed on same host
  %*   The macro can be tweaked to run Perl on a remote host.  Your SAS host
  %*   will need the ability to remote shell to the foreign host, as well as
  %*   send and receive stdio. Look for %***% comments
  %*
  %* Arguments:
  %*   All arguments are comma separated.
  %*   The first null argument is presumed to be the last arguement, thus
  %*   if you pass a null argument, all subsequent arguments are ignored
  %*
  %* Argument categories and special considerations:
  %*
  %*-----
  %* Excel output
  %*
  %*   FILE=<host-path>
  %*   FILEREF=<SAS-fileref>  FILEREF takes precedence if FILE is also present
  %*
  %*   If fileref _WEBOUT is passed, the proper content-type will be prepended
  %*   to the generated excel file
  %*
  %*-----
  %* Worksheet names and content source
  %*
  %*  Form1: SHEET<n>=[~][<SheetName>]:[<Heading>]:<Dataset>|<CatalogEntry>
  %*  Form2: SHEET<n>=<Dataset>|<CatalogEntry>
  %*
  %*  <n> can range from 1 to 50
  %*
  %*  Form 1:
  %*
  %*   [~][<SheetName>]:[<Heading>]:<Dataset>|<CatalogEntry>
  %*
  %*     ~ is optional
  %*
  %*       A special formatting indicator
  %*       If SheetName starts with tilde (~) the worksheet is formatted
  %*       to hide grid lines and all cells are Courier New font
  %*       Use this feature when transferring a PROCs text output to Excel.
  %*       A PROCs text output can be captured to a catalog entry by using Proc PRINTTO.
  %*
  %*     <SheetName> is optional
  %*
  %*       The worksheet name.
  %*       If not present, the dataset label of <Dataset> will be used
  %*       If <Dataset> is unlabelled, then <Dataset> will be used
  %*
  %*     <Heading> is optional
  %*
  %*       Heading controls what appears in Row 1 of the Excel worksheet.
  %*       Heading may be:
  %*         LABEL or L - Column label, name is used if unlabelled column
  %*         NAME or N - Column name
  %*         NONE or 0 or . - No column heading row
  %*       Heading defaults to NAME.
  %*
  %*     <Dataset>
  %*
  %*       A SAS data set or view to be placed in a Excel worksheet.
  %*       <Dataset> may contain any valid dataset options such as where=,
  *%       keep= and drop=.
  %*
  %*     <CatalogEntry>
  %*
  %*       A SOURCE catalog entry. Use either three-level or four-level.
  %*       If catalog entry is captured PROC text output the argument
  %*       should use the ~ prefix for best results.
  %*
  %*  Form 2:
  %*
  %*   <Dataset>|<CatalogEntry>
  %*
  %*     <Dataset>
  %*
  %*       A SAS data set or view to be placed in a Excel worksheet.
  %*       <Dataset> may contain any valid dataset options such as where=,
  *%       keep= and drop=.
  %*       The sheet will be named according to the dataset label.
  %*       If <Dataset> is unlabelled, then <Dataset> will be used
  %*
  %*     <CatalogEntry>
  %*
  %*       A SOURCE catalog entry. Use either three-level or four-level name.
  %*       The worksheet name is the memname.entry part of the resolved four-level name
  %*       and will be ~ formatted.
  %*
  %*-----
  %* Perl executable
  %*
  %*   PERL=<host-path>
  %*
  %*-----
  %* Work location for Perl program and Excel file
  %*
  %*   TEMPDIR=<host-path for temporary files>  default is /tmp deferring to WORK path
  %*
  %*
  %*
  %* Example to create an excel file with three worksheets:
  %*   %sas2xls (
  %*     FILEREF=_WEBOUT
  %*   , SHEET1=SASHELP.CLASS
  %*   , SHEET2=Libraries::SASHELP.VSLIB
  %*   , SHEET3=A list of the A tables:Label:SASHELP.VSTABLE(WHERE=(MEMNAME LIKE 'A%'))
  %*   )
  %*;

  %local NOTES SOURCE SOURCE2 MPRINT;

  %let NOTES   = %sysfunc (getoption(NOTES));
  %let SOURCE  = %sysfunc (getoption(SOURCE));
  %let SOURCE2 = %sysfunc (getoption(SOURCE2));
  %let MPRINT  = %sysfunc (getoption(MPRINT));

  options NONOTES NOSOURCE NOSOURCE2 NOMPRINT;

  %local THIS VERSION;
  %local FILE FILEREF XLS_FILE RC DSID I N L ARG P P1 P2 CTOKEN;
  %local LHS RHS DATASET WSNAME COMMA;
  %local PERL PERL_PGM PERL_RUN PERLPIPE;

  %let THIS = sas2xls;
  %let VERSION = 2002.05.29;

  %*---------------------------------------------------------------------------
  %* Check for XLS destination;

  %if (%nrbquote(&FILEREF) eq ) and (%nrbquote(&FILE) eq ) %then %do;
    %put ERROR: &THIS: No valid FILEREF or FILE was provided;
    %goto EndMacro;
  %end;

  %*---------------------------------------------------------------------------
  %* Check that FILEREF is assigned;

  %if (&FILEREF ne ) %then %do;
    %let FILE= ;
    %if (%sysfunc (fileref(&FILEREF)) > 0) %then
      %put ERROR: &THIS: Fileref &FILEREF is not assigned;
  %end;

  %*---------------------------------------------------------------------------
  %* Set TMP default;

  %if ("&TEMPDIR" eq "") %then
    %let TEMPDIR = /tmp;

  %*---------------------------------------------------------------------------
  %* Prepare to examine each parameter;

  %let I = 1;
  %let N = 0;

  %*---------------------------------------------------------------------------
  %* Examine each value of each sheet<n> parameter;

  %do %while (&I <= 50);

    %if (%superq(SHEET&I) eq) %then %goto NxtSheet;

    %let N = %eval (&N + 1);
    %local DS&N WN&N HD&N;

    %let P1 = %index (&&SHEET&I,:);
    %let P2 = %index (%qsubstr(&&SHEET&I( ),%eval(&P1+1)),:);

    %let CTOKEN =;

    %if &P2 > 0 %then %do;
      %* argument contains at least two :
      %* find out what, if anything is between the :;

      %if &P2 > 1 %then %do;
        %* there is something between the :;

        %let CTOKEN = %qsubstr(&&SHEET&I, %eval(&P1+1), %eval(&P2-1));
        %if %qupcase(&CTOKEN) = L or %qupcase(&CTOKEN) = LABEL %then
          %let CTOKEN = LABEL;
        %else
        %if %qupcase(&CTOKEN) = N or %qupcase(&CTOKEN) = NAME %then
          %let CTOKEN = NAME;
        %else
        %if (&CTOKEN = .) or (&CTOKEN = 0) or (%qupcase(&CTOKEN) = NONE) %then
          %let CTOKEN = NONE;
        %else %do;
          %put WARNING: &THIS: :&CTOKEN: in &&SHEET&I has defaulted to NAME;
          %let CTOKEN = NAME;
        %end;
      %end;
      %else
        %let CTOKEN = NAME;

      %let P2 = %eval (&P1+&P2);
    %end;

    %if (&CTOKEN ne ) %then %do;
      %* sheetname :: dataset|catalog;
      %if &P1 > 1 %then
        %let WN&N = %qsubstr(&&SHEET&I,1,%eval(&P1-1));

      %if &P2 < %length (&&SHEET&I) %then
        %let DS&N = %qsubstr (&&SHEET&I,%eval(&P2+1));
      %let HD&N = &CTOKEN;
    %end;
    %else %do;
      %* dataset|catalog;
      %let WN&N = ;
      %let DS&N = &&SHEET&I;
      %let HD&N = NAME;
    %end;

%NxtSheet:
    %let I = %eval (&I+1);
  %end;

  %*---------------------------------------------------------------------------
  %* Check if any sheets indicated ;

  %if (&N = 0) %then %do;
    %put WARNING: &THIS: No sheets were indicated.;
    %goto EndMacro;
  %end;

  %*---------------------------------------------------------------------------
  %* Write first part of Perl program ;

  %let PERL_PGM = _%substr (%sysfunc (ranuni(0), 9.7), 3);
  %let PERL_RUN = _%substr (%sysfunc (ranuni(0), 9.7), 3);

  %if (%nrbquote(&FILEREF) ne ) %then
    %let XLS_FILE = &TEMPDIR./_%substr (%sysfunc (ranuni(0), 9.7), 3).xls;
  %else
    %let XLS_FILE = &FILE;

  filename &PERL_PGM "&TEMPDIR./&PERL_PGM..pl";

     %let PERLPIPE = &PERL %sysfunc(pathname(&PERL_PGM)) > &XLS_FILE;
%*** %let PERLPIPE = cat %sysfunc(pathname(&PERL_PGM)) | remsh remote-host -l guest-user-for-perl perl -w > &XLS_FILE;

  data _null_;
    file &PERL_PGM recfm=N;

    put   'use strict;'
    '0A'X 'use Spreadsheet::WriteExcel;'
    '0A'X 'my $workbook  = Spreadsheet::WriteExcel->new("-");'
    '0A'X 'my @data = ('
    ;
  run;

  %if &SYSERR ne 0 %then %do;
    %put ERROR: &THIS: An error occurred.;
    %goto EndMacro;
  %end;

  %*---------------------------------------------------------------------------
  %* Write SAS data as Perl array initializations;

  %let COMMA = %str( );
  %do I = 1 %to &N;

%*  %put [&&DS&I] [&&WN&I] [&&HD&I];

    %sas2perl (DATA=&&DS&I, WSNAME=&&WN&I,  HEADING=&&HD&I, PERL_PGM=&PERL_PGM, DATACOMA=COMMA) ;
  %end;

  %*---------------------------------------------------------------------------
  %* Write last part of Perl program ;

  data _null_;
    file &PERL_PGM mod;

    put ');'
     // 'if (scalar @data == 0) { @data=(["Warning",[["No data exported"]]]);}'
     // 'my $courier = $workbook->addformat(font=>"Courier New");'
     // 'my $worksheet;'
     // 'foreach my $sheet ( @data ) {'
      / '  my $sheetName = $sheet->[0];'
      / '  my $sheetData = $sheet->[1];'
      / '  if ( $sheetName =~ /^~/) { '
      / '    $worksheet = $workbook->addworksheet(substr($sheetName,1));'
      / '    $worksheet->write(0,0,[$sheetData],$courier);'
      / '    $worksheet->hide_gridlines(2); '
      / '  }'
      / '  else {'
      / '    $workbook->addworksheet($sheetName)->write(0,0,[$sheetData]);'
      / '  }'
      / '}'
     // "if (__FILE__ ne '-') { unlink __FILE__; } "
    ;
  run;

  %if &SYSERR ne 0 %then %do;
    %put ERROR: &THIS: An error occurred.;
    %goto EndMacro;
  %end;

 /*;

  data _null_;
    infile &PERL_PGM;
    input;
    put _N_ _infile_;
  run;

*/;

  filename &PERL_RUN PIPE "&PERLPIPE";
  data _null_;
    infile &PERL_RUN;
    input;
    put _infile_;
  run;

  %if &SYSERR ne 0 %then %do;
    %put ERROR: &THIS: An error occurred.;
  %end;

  %if (%nrbquote(&FILEREF) ne ) %then %do;
  data _null_;

    %if (%qupcase(&FILEREF) eq _WEBOUT) %then
      file &FILEREF recfm=S;
    %else
      file &FILEREF recfm=N;
    ;

    infile "&XLS_FILE" recfm=n;

    if _n_ = %eval (%qupcase(&FILEREF) eq _WEBOUT) then
      put 'Content-type: application/vnd.ms-excel' '0A0A'x @;

    input c $char1.;
    put c $char1. @@;
  run;
  %end;

%EndMacro:

  %if (&PERL_PGM ne ) %then %do;
    %let RC = %sysfunc (fileref (&PERL_PGM));
    %if &RC <= 0 %then %do;
      %if &RC = 0 %then
        %let RC = %sysfunc (fdelete (&PERL_PGM));
      filename &PERL_PGM;
    %end;
  %end;

  %if (&PERL_RUN ne ) %then %do;
    %let RC = %sysfunc (fileref (&PERL_RUN));
    %if &RC <= 0 %then %do;
      filename &PERL_RUN;
    %end;
  %end;

  %if (&FILEREF ne ) %then %do;
    filename &PERL_RUN "&XLS_FILE";
    %let RC = %sysfunc (fdelete (&PERL_RUN));
    filename &PERL_RUN ;
  %end;

  options &NOTES &SOURCE &SOURCE2 &MPRINT;

%mend sas2xls;


%*****************************************************************************;


%macro perlStr (dsVar);
  &dsVar = tranwrd (&dsVar, "\", "\\");
  &dsVar = tranwrd (&dsVar, "'", "\'");

  if length(&dsVar) > 198 then do;
    &dsVar = substr(&dsVar,1,198);
    if substr (&dsVar,198,1) eq "\" and
       substr (&dsVar,197,1) ne "\"
    then
      &dsVar = substr (&dsVar,1,197);
  end;

  &dsVar = "'" || trim (left (&dsVar)) || "'";
%mend perlStr;


%*****************************************************************************;


%macro sas2perl
(
  PERL_PGM =
, WSNAME =
, DATA =
, HEADING = NAME
, DATACOMA =
);

  %*
  %* Richard A. DeVenezia
  %*  5/17/02
  %*
  %* Output data as an element of a Perl array assignment
  %*
  %* PERL_PGM - fileref to Perl program that will receive data information
  %* WSNAME - name of worksheet to put data in
  %* DATA - name of data set to export
  %* HEADING - name, label or none
  %* DATACOMA - name of macro variable in callers scope, needed for repeated
  %*            invocations of this macro in a loop
  %*
  %* The Perl array is three dimensions and one element looks like
  %*
  %* ["<sheet name>",
  %*  [
  %*   [ r<1>c<1>, ..., r<1>c<m> ]
  %* , [ ... ]
  %* , [ r<n>c<1>, ..., r<n>c<m> ]
  %*  ]
  %* ]
  %*;

  %local NOTES SOURCE SOURCE2 MPRINT;

  %let NOTES   = %sysfunc (getoption(NOTES));
  %let SOURCE  = %sysfunc (getoption(SOURCE));
  %let SOURCE2 = %sysfunc (getoption(SOURCE2));
  %let MPRINT  = %sysfunc (getoption(MPRINT));

  options NONOTES NOSOURCE NOSOURCE2 NOMPRINT;

  %local THIS VERSION CONTENTS ;
  %local RC CATENTRY;

  %let THIS = sas2perl;
  %let VERSION = 2002.05.29;

  %let CONTENTS = _%substr (%sysfunc (ranuni(0), 9.7), 3);
  %let END      = _%substr (%sysfunc (ranuni(0), 9.7), 3);

  %*---------------------------------------------------------------------------
  %* Validate PERL_PGM;

  %if (%superq (PERL_PGM) eq ) %then %do;
    %put ERROR: &THIS: PERL_PGM was either not set or not passed;
    %goto EndMacro;
  %end;
  %else
  %if (%sysfunc (fileref(&PERL_PGM)) > 0) %then %do;
    %put ERROR: &THIS: PERL_PGM Fileref &PERL_PGM is not assigned;
    %goto EndMacro;
  %end;

  %*---------------------------------------------------------------------------
  %* Check if data is coming from a catalog source entry;

  %if (%sysfunc (cexist (&DATA..SOURCE,CATALOG))) %then
    %let CATENTRY = &DATA..SOURCE;
  %else
  %if (%sysfunc (cexist (&DATA))) %then
    %let CATENTRY = &DATA;
  %else
  %if (%sysfunc (exist (&DATA,DATA))) %then
    %let CATENTRY = ;
  %else
  %if (%sysfunc (exist (&DATA,VIEW))) %then
    %let CATENTRY = ;

%put CATENTRY=&CATENTRY;

  %if (&CATENTRY ne ) %then %do;

    %*-------------------------------------------------------------------------
    %* Output the CATALOG SOURCE entry as part of a Perl array initialization;

    %if (%superq(WSNAME) eq ) %then %do;
      %let WSNAME = ~%scan(&CATENTRY,2,.).%scan(&CATENTRY,3,.);
    %end;

    filename &CONTENTS catalog "&CATENTRY";

    data _null_;
      length line $200;

      file &PERL_PGM mod recfm=N;

      line = symget ('WSNAME');

      %perlStr(line);
      put '0A'x "&&&DATACOMA" '0A'x '[' line ', [' ;

      rowComma = ' ';
      do while (not end);
        infile &CONTENTS length=len end=end;
        input line $varying200. len;
        %perlStr(line);

        put '0A'X rowComma '[' line ']';
        rowComma = ',';
      end;

      put '0A'X ']]';

      stop;
    run;

    filename &CONTENTS;

    %let &DATACOMA = , ;

    %goto EndMacro;
  %end;

  %*---------------------------------------------------------------------------
  %* Validate HEADING;

  %let HEADING = %upcase(&HEADING);

  %if %index(|NAME|LABEL|NONE|, |&HEADING|) eq 0 %then %do;
    %put WARNING: &THIS: Heading &HEADING is invalid, it has been set to NAME;
    %let HEADING = NAME;
  %end;

  %if (%superq(WSNAME) eq ) %then %do;
    %let WSNAME = %str( );
  %end;

  %*---------------------------------------------------------------------------
  %* Output the DATA as part of a Perl array initialization;

  %local error;

  %let error = 0;

  data _null_;

    length data $200;

    data = symget ('DATA');
    dsid = open (data);

    if dsid = 0 then do;
      put "WARNING: &THIS: " data "could not be opened.";
      call symput ('error', 1);
      stop;
    end;

    file &PERL_PGM mod recfm=N;

    data = symget ('DATA');
    put '0A0A'x '# ' data;

    data = symget ('WSNAME');
    if data = "" then data = attrc (dsid, 'LABEL');
    if data = "" then data = attrc (dsid, 'MEM');

    %perlStr(data);

    put '0A'x "&&&DATACOMA" '0A'x '[' data ', [' ;

    %*.........................................................................
    %* Header line if requested;

    comma = ' ';
    rowComma = ' ';

    nVar = attrn (dsid, 'NVAR') ;

    put '0A'X rowComma '[';

    do i = 1 to nVar while (%eval(&HEADING ne ));

      %if (&HEADING = LABEL) %then %do;
        data = varlabel (dsid, i); ;
        if data = "" then
          data = varname (dsid, i);
      %end;
      %else
      %if (&HEADING = NAME) %then %do;
        data = varname (dsid, i);
      %end;

      %perlStr (data);

      put comma data ;

      comma = ',';

    end;

    put ']';

    rowComma = comma;  %* comma will be a comma if a header row was output;

    %*.........................................................................
    %* Data portion;

    do while (0 = fetch (dsid));
      put '0A'X rowComma '[';

      comma = ' ';
      do i = 1 to nVar;
        varFmt = varFmt (dsid,i);

        if varType (dsid,i) = 'C' then do;
          data = getVarC (dsid, i);
          if varFmt ne '' then do;
            data = putC (data, varFmt);
            %perlStr (data);
            put comma data;
          end;
          else do;
            %perlStr (data);
            put comma data;
          end;
        end;
        else do;
          dataN = getVarN (dsid, i);
          if varFmt ne '' then do;
            data = putN (dataN, varFmt);
            %perlStr (data);
            put comma data;
          end;
          else do;
            if dataN ne . then
              put comma dataN;
            else
              put comma 'undef';
          end;
        end;
        comma = ',';
      end;

      put ']';
    end;

    rc = close (dsid);

    put '0A'X ']]';

    stop;
  run;

  %if (not &ERROR) %then
    %let &DATACOMA = , ;

%EndMacro:

  options &NOTES &SOURCE &SOURCE2 &MPRINT;

%mend sas2perl;