Download webframe.sas webframe.sasSubmit a comment

/*******************************************************************\
| Copyright (C) 2000 by SAS Institute Inc., Cary, NC, USA.          |
|                                                                   |
| SAS (R) is a registered trademark of SAS Institute Inc.           |
|                                                                   |
| SAS Institute does not assume responsibility for the accuracy of  |
| any material presented in this file.                              |
\*******************************************************************/

%* mod
%*  4/11/00 RAD use SQL to get object descriptions for use as thumbnail
%*              labels. use object name as filename;
%*  4/12/00 RAD work on caching issues, use datetime() to uniquely name
%*              frame pieces.
%*              Return in _START_ filename of main frame;
%*  4/17/00 RAD allow GIF device driver as a named argument;

/**********************************************************************/
/* This program creates HTML and GIF files in version 6.12 that mimic */
/* the format created by the WEBFRAME device first available in       */
/* version 7 of the SAS system.  It assumes you want to display all   */
/* the graphs stored in the specified catalog.  It will create a      */
/* parent page, PFRAME.HTML, that displays two smaller frames.  The   */
/* left frame, THUMB.HTML, will contain a list of all the graphs,     */
/* including a thumbnail image and a text link for each.  Selecting   */
/* one of these links will display the larger GIF image of the same   */
/* graph in the right frame.  Initially, the first graph in the       */
/* catalog is displayed in the right frame.                           */
/*                                                                    */
/* As with the WEBFRAME driver, the parent frame and index frame are  */
/* named automatically. Unlike the WEBFRAME driver, the images and    */
/* links on these pages are not automatically given the GRSEG names   */
/* of the graphs.  Use the NAME parameter when invoking the macro to  */
/* name the links on the list page, the large GIF files, and the      */
/* displayed HTML files.  The directory you specify to store the      */
/* files must already exist; SAS will not create the directory for    */
/* you.                                                               */
/**********************************************************************/

/**********************************************************************/
/* Uncomment this statement to troubleshoot the macro.                */
/**********************************************************************/
* options nomprint nomlogic nosymbolgen;

/**********************************************************************/
/* Define the macro FRAME.                                            */
/* UNQPRFX:  Unique prefix, used to created web files and to delete   */
/*           web files before creating new ones                       */
/* TITLE:    Text to show above thumbnails                            */
/* LIBRARY:  The library where the graphs are stored.                 */
/* CATALOG:  The catalog where the graphs are stored.                 */
/* PATH:     The physical location (drive & directory) where you want */
/*           to store the output files.                               */
/* HSIZE:    The HSIZE to use to generate the large GIF files.        */
/* VSIZE:    The VSIZE to use to generate the large GIF files.        */
/* _START_:  Contains name of macro variable in caller scope that     */
/*           will contain name of pframe generated                    */
/*                                                                    */
/* The macro does not contain parameters to name the parent frame or  */
/* the list frame.  These frames are named PFRAME.HTML and THUMB.HTML */
/* by default, but these names can be changed within the macro before */
/* compiling if desired.                                              */
/**********************************************************************/

%macro webframe(unqprfx,title,library,catalog,path,hsize,vsize,_start_,dirsep=/,gifdevce=GIF);

%local title library catalog path hsize vsize dirsep;
%local badpath i numgraph;

%local _device _target _gsfname _gsfmode _hsize _vsize;

%let _device  = %sysfunc (getoption (device));
%let _target  = %sysfunc (getoption (targetdevice));
%let _gsfname = %sysfunc (getoption (gsfname));
%let _gsfmode = %sysfunc (getoption (gsfmode));
%let _hsize   = %sysfunc (getoption (hsize));
%let _vsize   = %sysfunc (getoption (vsize));

%let badpath = 1;
data _null_;
  length fref $32;
  fref = '';
  rc = filename (fref, "&PATH");
  if rc = 0 then do;
    did = dopen (fref);
    if did then do;
      call symput ("badpath", '0');
      did = dclose (did);
    end;
    rc = filename (fref, '');
  end;
run;

%if &badpath %then %goto Bye;

/**********************************************************************/
/* Delete files in path with same unique prefix                       */
/**********************************************************************/

data _null_;
  * will hold list of files that are to be deleted;
  * need to be stored since dread(i) can change after fdelete;
  array fname[500] $200 _temporary_;

  length dref fref $32;
  retain dref fref '';

  * open the directory;
  dref = '';
  rc = filename (dref, "&PATH");
  if rc = 0 then do;
    did = dopen (dref);
    if did then do;
      * find each file matching the prefix;
      j = 0;
      do i = 1 to dnum (did);
        filename = dread (did, i);
	if trim(upcase(filename)) =: trim(upcase("&unqprfx")) then do;
	  j++1;
	  fname[j] = filename;
	end;
      end;
      did = dclose (did);

      do i = 1 to dim(fname) while (fname[i] ne '');
        fref = '';
        rc = filename (fref, "&PATH.&DIRSEP."||trim(fname[i]));
        if rc = 0 then do;
          rc = fdelete (fref);
          rc = filename (fref, '');
	end;
      end;
    end;
    rc = filename (dref, '');
  end;
run;

/**********************************************************************/
/* Find the number of graphs in the catalog.  Save this count         */
/* as NUMGRAPH.                                                       */
/**********************************************************************/

proc sql;
  create table gsegs as select * from DICTIONARY.CATALOGS
  where libname="%upcase(&library)"
    and memname="%upcase(&catalog)" and objtype='GRSEG';
quit;

%let numgraph = &SQLOBS;

options symbolgen;

%do i = 1 %to &numgraph;
  %local gname&i gdesc&i;
%end;

data _null_;
  set gsegs;
  if objdesc =: 'PLOT OF ' then objdesc = substr(objdesc,9);
  p = index (objdesc, '*');
  if p > 1 then objdesc = substr(objdesc,1,p-1);
  call symput ('gdesc'||trim(left(put(_n_,4.))), trim(objdesc));
  call symput ('gname'||trim(left(put(_n_,4.))), trim(objname));
run;


    %*----------------------------------;
    %local localdbg;

    %let localdbg = 0;

    %if &localdbg %then %do;

        %out2htm(capture=on,
             window=output,
             runmode=b);

        proc print data=gsegs;
        run;

        %out2htm(htmlfref=_WEBOUT,
             capture=off,
             window=output,
             openmode=replace,
             runmode=b);

	%goto Bye;
    %end;
    %*----------------------------------;

%let unqsufx = %sysfunc (datetime(), hex16.);

/**********************************************************************/
/* Make the large GIFs, the thumbnails, and the html pages for the    */
/* graphs.                                                            */
/**********************************************************************/

%put &numgraph;

%do i=1 %to &numgraph;
  filename out "&path.&dirsep.&unqprfx.-&&gname&i..-&unqsufx..gif";
  goptions dev=&gifdevce target=&gifdevce gsfname=out gsfmode=replace hsize=&hsize vsize=&vsize;
  proc greplay nofs igout=&library..&catalog ;
    replay &i;
  run;quit;

  %* for some reason, for some graphs, 0.5x0.5 cause GIF driver lockup;
  goptions hsize=.7 vsize=.7;

  filename out "&path.&dirsep.&unqprfx.-thumb&i.-&unqsufx..gif";
  proc greplay nofs igout=&library..&catalog ;
    replay &i;
  run;quit;

  filename page "&path.&dirsep.&unqprfx.-&&gname&i..-&unqsufx..html";
  data _null_;
    file page;
    put '<HTML>';
    put '<HEAD>';
/*
    put '<META HTTP-EQUIV="refresh" CONTENT="999999999;">';
    put '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">';
    put '<META HTTP-EQUIV="expired" CONTENT="01-Mar-94 00:00:01 GMT">';
*/
    put '</HEAD>';
    put '<P ALIGN=CENTER><IMG SRC="' "&unqprfx.-&&gname&i..-&unqsufx..gif" '"></P>';
    put '</HTML>';
  run;
%end;

/**********************************************************************/
/* Create the parent frame, PFRAME.HTML.  The left frame will be 15%  */
/* of the initial browser window size.                                */
/**********************************************************************/

%let &_start_ = &unqprfx.-pframe-&unqsufx..html;

filename parent "&path.&dirsep.&&&_start_";
data _null_;
  file parent;
  put '<HTML>';
  put '<HEAD>';
  put '<TITLE>SAS/Graph</TITLE>';
/*
  put '<META HTTP-EQUIV="refresh" CONTENT="999999999;">';
  put '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">';
  put '<META HTTP-EQUIV="expired" CONTENT="01-Mar-94 00:00:01 GMT">';
*/
  put '</HEAD>';

  put '<FRAMESET COLS="15%,*">';
  put '<NOFRAMES>';
  put 'Sorry, this frame output can only be viewed with a' @@;
  put ' frame capable browser like Netscape 2.0 and above.';
  put '</NOFRAMES>';
  put '<FRAME SRC="' "&unqprfx.-thumb-&unqsufx..html"    '">';
  put '<FRAME SRC="' "&unqprfx.-&gname1.-&unqsufx..html" '" NAME="view_frame">';
  put '</FRAMESET>';
  put '</HTML>';
run;

/**********************************************************************/
/* Create the thumbnail page, THUMB.HTML.                             */
/**********************************************************************/
filename list "&path.&dirsep.&unqprfx.-thumb-&unqsufx..html";
data _null_;
  file list;
  put '<HTML>';

  put '<HEAD>';
/*
  put '<META HTTP-EQUIV="refresh" CONTENT="999999999;">';
  put '<META HTTP-EQUIV="Pragma" CONTENT="no-cache">';
  put '<META HTTP-EQUIV="expired" CONTENT="01-Mar-94 00:00:01 GMT">';
*/
  put '</HEAD>';

  put '<BASE TARGET=view_frame>';
  put "<H2 ALIGN=CENTER>&TITLE</H2>";
  %do i=1 %to &numgraph;
    put '<P ALIGN=CENTER>';
    put '<A HREF="' @@;
    put "&unqprfx.-&&gname&i..-&unqsufx..html" @@;
    put '"><IMG SRC="' @@;
    put "&unqprfx.-thumb&i.-&unqsufx..gif" @@;
    put '"><BR>';
    put "&&gdesc&i" @@;
    put '</A></P>';
  %end;
  put '</HTML>';
run;

%Bye:

goptions
  device       = &_device
  targetdevice = &_target
  gsfname      = &_gsfname
  gsfmode      = &_gsfmode
  hsize        = &_hsize
  vsize        = &_vsize
;

%mend webframe;

/**********************************************************************/