/* *************************************************************** */
/* mwsug95.sas - generates a form or responds to it. */
/* if REQUEST_METHOD is GET then this generates a form. */
/* if REQUEST_METHOD is POST then it responds to the form. */
/* This must be called from a script which sets appropriate */
/* environment variables and redirects std IO without buffering. */
/* */
/* Larry Hoyle, IPPBR, University of Kansas July 1995 */
/* *************************************************************** */
%global maxlen; /* maximum length of name or value string from httpd */
%let maxlen=200;
%global host; /* the name host for which statistics are requested */
%global request; /* the type of request eg. "source" or "stats" */
filename mwlist '/homea/http/scripts/ippbr/mwsug95/mw95list';
/* *********************************************************** */
/* read the environment variables into SAS macro variables. */
/* *********************************************************** */
%global rqmeth; /* request method environment variable */
%let rqmeth=%sysget(REQUEST_METHOD);
%global cnttyp; /* content type environment variable */
%let cnttyp=%sysget(CONTENT_TYPE);
%global cntlen; /* content length environment variable */
%let cntlen=%sysget(CONTENT_LENGTH);
%global remadr; /* remote address environment variable */
%let remadr=%sysget(REMOTE_ADDR);
%global remhst; /* remote host environment variable */
%let remhst=%sysget(REMOTE_HOST);
data _null_;
put 'ENVIRONMENT VARIABLES:';
put 'request method = ' "&rqmeth";
put 'content type = ' "&cnttyp";
put 'content length = ' "&cntlen";
put 'remote address = ' "&remadr";
put 'remote host = ' "&remhst";
run;
/* macro tstmthd tests for REQUEST_METHOD and either sends a form */
/* or processes one */
%macro tstmthd;
%if %upcase(&rqmeth)=GET %then
%do; /* GET */
/* *********************************************************** */
/* send back a form which points back to this SAS program */
/* *********************************************************** */
data accesses;
infile mwlist lrecl=40 pad;
length wkday $ 3 host $ 40 ip $ 40;
input wkday $ 1-3 / host $40. / ip $40.;
proc sort data=accesses NODUPKEY;
by host;
run;
data _null_;
file STDOUT;
set accesses end=last;
by host;
if _n_=1 then do;
put 'content-type: text/html';
put;
put 'Example for MidWest SAS Users Group 1995 Conference';
put 'More on using SAS with WWW
';
put "This form was requested by &remhst from the ip address";
put "&remadr";
put 'It was generated by a SAS program.';
put "
";
put 'This is the example for an online poster to be presented to the';
put '1995 MidWest SAS Users Group Conference October 22-24, 1995 in Cleveland.';
put '';
put 'revised: Oct. 25, 1995 - changed incorrect use of _n_=1.';
put 'Statistics should now print for any address selected.';
put '
revised May 10, 1996 - the statistics report was printing the address of the client.';
put ' It now prints the proper address in the title';
put '
';
put '';
put '
';
put 'Please mail comments to Larry Hoyle:';
put '
';
put 'l-hoyle@ukans.edu';
put '
';
put '';
put 'Institute for Public Policy and Business Research, University of Kansas';
put '';
end; /* last */
run;
%end; /* GET */
%if %upcase(&rqmeth)=POST %then
%do; /* post */
/* *********************************************************** */
/* read the data from the form and create a dataset */
/* with name-value pairs. */
/* *********************************************************** */
data namevals;
length name $ &maxlen value $ &maxlen hexstr $ 2;
array s{2} name value;
keep name value;
length c $ 1;
retain ixs name value;
keep name value;
infile stdin lrecl=1 recfm=f;
ixs=1;
name=' ';
value=' ';
do ixc=1 to &cntlen;
input c $char1. @@;
put c=;
select(c);
when('&')do;
name=left(name);
value=left(value);
output;
put value=;
ixs=1;
name=' ';
value=' ';
end; /* when '&' */
when('=')do;
put name=;
ixs=2;
end; /* when '=' */
when('%')do;
input c $CHAR1.;
substr(hexstr,1,1)=c;
input c $CHAR1.;
substr(hexstr,2,1)=c;
c=input(hexstr,$HEX2.);
s(ixs)=trim(s(ixs))||c;
ixc=ixc+2;
if ixc gt &cntlen then do;
/* ixc is the index var */
/* if it increments past */
/* &cntlen something is wrong */
put 'index loop overrun';
abort;
end; /* if ixc */
end; /* when '%' */
otherwise do;
s(ixs)=trim(s(ixs))||c;
end; /* otherwise */
end; /* select(c) */
end; /* do ixc */
/* the last name value pair has no trailing & */
/* output them now */
name=left(name);
value=left(value);
output;
put value=;
stop; /* no more input after loop */
/* *********************************************************** */
/* process the name value pairs */
/* *********************************************************** */
data _null_;
set namevals;
select(name);
when('request')do;
call symput(name,trim(value));
end;
when('host')do;
call symput(name,trim(value));
end;
end; /* select */
/* ************************************************************ */
/* echo all macro variables to the log */
/* ************************************************************ */
data _null_;
put "host=&host" / "request=&request";
run;
%end; /* POST */
%mend tstmthd;
/* macro reply generates an appropriate response to the HTML form */
/* based on the contents of the macro variable reqtyp */
%macro reply;
%if %upcase(&rqmeth)=POST %then
%do; /* post */
/* ***************************************************** */
/* begin the stats section (request=stats) */
/* ***************************************************** */
%if %upcase(&request)=STATS %then
%do; /* STATS section */
data accesses;
infile mwlist lrecl=40 pad;
retain beenhere 0;
drop beenhere;
length wkday $ 3 hour $ 2 host $ 40 ip $ 40;
input wkday $ 1-3 hour $ 12-13 / host $40. / ip $40.;
if host="&host";
file STDOUT;
if not(beenhere) then do;
beenhere=1;
put 'content-type: text/html';
put;
put ' statistics from the SAS job ';
put " Usage statistics
";
put '';
put host "(" ip ") used the MWSUG95 form at the following times:";
put ' Hours are listed in Coordinated Universal Time';
end; /* not(beenhere) */
proc printto print=STDOUT;
proc freq data=accesses;
table hour*wkday;
run;
%end; /* STATS section */
/* ***************************************************** */
/* begin the source section (request=source) */
/* ***************************************************** */
%if %upcase(&request)=SOURCE %then
%do; /* SOURCE section */
filename mwsug95 '/homea/http/scripts/ippbr/mwsug95/mwsug95.sas' recfm=n;
data _null_;
put 'Executing source section';
data _null_;
infile mwsug95 end=last ;
file STDOUT ;
length cr $ 1;
length c $ 1;
cr='0D'x;
if _n_ = 1 then do;
put 'content-type: text/html';
put;
put ' SAS code serving the MWSUG95 form ';
put '';
end;
/* *********************************************** */
input c $char1. @@;
select(c); /* escape the codes for tags */
when('<') put '<'@@;
when('>') put '>'@@;
when('&') put '&'@@;
when('0A'x) put ;
otherwise put c $char1. @@;
end;
/* *********************************************** */
if last then put '';
run;
%end; /* source section */
/* ***************************************************** */
/* begin the script section (request=script) */
/* ***************************************************** */
%if %upcase(&request)=SCRIPT %then
%do; /* SCRIPT section */
filename mwsug95 '/homea/http/scripts/ippbr/mwsug95/cgisas_mwsug95' recfm=n;
data _null_;
put 'Executing script section';
data _null_;
infile mwsug95 end=last ;
file STDOUT ;
length cr $ 1;
length c $ 1;
cr='0D'x;
if _n_ = 1 then do;
put 'content-type: text/html';
put;
put ' Shell script to execute the SAS code ';
put '';
end;
/* *********************************************** */
input c $char1. @@;
select(c); /* escape the codes for tags */
when('<') put '<'@@;
when('>') put '>'@@;
when('&') put '&'@@;
when('0A'x) put ;
otherwise put c $char1. @@;
end;
/* *********************************************** */
if last then put '';
run;
%end; /* script section */
%end; /* POST */
%mend reply;
%tstmthd
%reply