#!/usr/local/bin/perl # Script: sasfile (sasfile.pl) # Version: 0.7 Thu Mar 14 13:45:48 EST 1996 # Author: Michael Friendly $www_url = 'http://www.math.yorku.ca/SCS/Online/sasweb'; $www_doc = 'Running SAS on the Web'; # sasfile is a perl script designed to allow a web server to serve .sas # files in a way that the remote user can either view the file locally, # or have that file execute under SAS on his/her local machine. # The object is to explore greater connectivity between SAS and the WWW. # Usage: # display: http://server.name/cgi-bin/sasfile/path/to/file.sas # run: http://server.name/cgi-bin/sasfile/path/to/file.sas?run # Features: # - finds %include references, provides hotlinks to those files # - finds embedded block comments marked by /*: ... :*/, and # treats them as normal text #--------- Configuration items --------- # who's serving these files? $server = 'http://hotspur.psych.yorku.ca'; # the URL (server-based) directory which is root to the sas files $server_dir = "$server/pavlov"; # the local filesystem name for this directory $sas_dir = '/users/faculty/friendly/sas_pavlov'; #-- Directories under sas_dir to look for %include data(), etc @include_types = ('macros', 'data', 'nwk'); @include_data = ('data', 'psy3030/data', 'psy6140/data'); @include_macros = ('macros', 'psy3030/macros', 'psy6140/macros'); @include_nwk = ('psy3030/nwk'); #-- MIME type to cause the browser to run SAS. This should probably # be a list. $sas_mime_type = 'application/x-sas'; #-- Images used by this script $webimage = qq(); $launchimage = qq(); #-- Input line separator (these files are stored on a Novell network) $/ = "\r\n"; #-- HTML tag used to display sas code. Using avoids problems # some browsers have with they find <, > inside
 blocks,
#   but the more general solution is to use HTML escapes for these chars.
$sastag = 'listing';

#--------- End of Configuration items ---------

$ENV{'PATH'}="/bin:/usr/bin:/usr/ucb";       # untaint $PATH

#-- Dependencies
require 5.000;	# This is a perl5 script
use CGI;

#-- Let's get started
$query = new CGI;

# unbuffer output so that we can see it as it comes 
# out, rather than waiting for buffers to flush
$| = 1;

$file_wanted = $query->path_info() || $ARGV[0];
$filename = substr ($file_wanted, rindex ($file_wanted, '/') + 1);
$file_path = "$sas_dir/$file_wanted";

# We may want to restrict running of the sas program to some particular
# browsers (user_agent) or remote locations (e.g., a local student lab).

$user_agent = $query->user_agent;
$remote = $query->remote_host;

# Only offer to launch if they accept the sas mime type.  This will
# include any browser that accepts */* (Netscape)

@mime_types = $query->accept;
$browser_accepts_sas = $query->accept($sas_mime_type) ||
		($remote =~ /yorku/);

# get any keyword parameters passed with the url
@keywords = $query->keywords;
$running = grep(/run/i,@keywords);
$debug = grep(/debug/i, @keywords);

$file_found = &get_sasfile;

&print_HTTP_header;
if ($running) {
	&print_body;
	}
else {
	&print_head;
	print "

$webimage$ filename

\n"; &find_title; $filetime = &mtime((stat($file_path))[9]); print "Last modified: $filetime\n"; &find_includes; @sasfile = &process_code(@sasfile); &print_body; &print_tail; &print_env if $debug; print $query->end_html, "\n"; } # ----------------- subroutines ------------ sub print_HTTP_header { if ($running ) { print $query->header($sas_mime_type); } else { print $query->header; } } sub print_head { print $query->start_html($filename, 'friendly@yorku.ca'); } sub get_sasfile { if (-e $file_path) { open(SAS, "$file_path"); @sasfile = ; # remove input record separator chomp(@sasfile); close(SAS); return 1; } else { return 0; } } #-- Handle embedded comment blocks marked by /*: .... :*/ # as normal text sub process_code { local (@source) = @_; local ($incode) = 1; line: foreach $i (0..$#source) { if ($source[$i] =~ m|^\s*/\*:|) { $source[$i] = "\n

"; $incode--; } #-- blank lines inside such comments ->

elsif ($incode<1 && $source[$i] =~ m|^\s*$|) { $source[$i] = "

"; } elsif ($source[$i] =~ m|^\s*:\*/|) { $source[$i] = "<$sastag>"; $incode++; } } return(@source); } sub print_body { local($myself); if ($file_found) { unless ($running) { # get a pointer to the script as called from the browser $myself = $query->self_url; print qq($launchimage Click here to run me on your machine!) if $browser_accepts_sas; print "


\n"; print "<$sastag>\n"; } print join("\n", @sasfile); print "\n" unless $running; } else { print "$file_wanted not found\n"; } } sub print_tail { print < For information on how this SAS file is served and how to set up a browser to launch SAS from the Web, see $www_doc.
Michael Friendly
Email: friendly\@yorku.ca
END } # Dump the environment variables -- for debugging sub print_env { print "
\n"; print "

Current Values

\n$query\n"; print "File: $file_wanted\n
"; # print "Run sas: $browser_accepts_sas\n
"; print "

CGI Environment

\n"; print "
\n";
	foreach $var (keys %ENV){
			print "$var = $ENV{$var}\n";
	}
	print "\n\n
\n"; } # Find and print the first title statement in the program sub find_title { $title = ''; @titles = grep( /^title /i, @sasfile); foreach (@titles) { if (/title\s+(["'])(.*)\1/i) { $title = $2; print "title: $title
\n"; last; } } } # Find included files -- either %include or *include (used when local # include files are stored in an autocall library). # For safety, only recognize include statements which start at the # beginning of the line. sub find_includes { local(@increfs) = ''; local($incpat) = join("|", @include_types); local(@includes) = grep( /^[%\*]include /, @sasfile); foreach (@includes) { if (/include ($incpat)\((\w+)\)/) { ($type, $incfile) = ($1, $2); $incfile =~ tr/A-Z/a-z/; if ($type eq 'macros') { foreach $loc (@include_macros) { if (-f "$sas_dir/$loc/$incfile.sas") { $ref = qq() . "%include $type($incfile);"; push(@increfs, $ref); last; } } } elsif ($type eq 'data') { foreach $loc (@include_data) { if (-f "$sas_dir/$loc/$incfile.sas") { $ref = qq() . "%include $type($incfile);"; push(@increfs, $ref); last; } } } } # include fileref - not an aggregate elsif (/include (\w+)\s*;/) { $incfile = $1; # look for file in the same directory $file_dir = substr ($file_path, 0, rindex ($file_path, '/')); if (-f "$file_dir/$incfile.sas") { ($file_local = "$file_dir/$incfile.sas") =~ s#$sas_dir#$server_dir#; $file_local =~ s#//#/#g; $ref = qq() . "%include $incfile;"; push(@increfs, $ref); } } } # If we found any %includes, print a list of hotlinks to them if (@increfs) { print "
\n

%includes

\n"; print <<"END"; $filename includes references to the following server data file(s) and macro(s). You may wish to download them first. (With most browsers, shift-Click on the link and select an appropriate directory.) END print "
    \n"; print join("\n
  • ",@increfs); print "\n
\n"; } } sub mtime { local($time) = @_; local($[) = 0; local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); local(@MoY) = ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec'); # Determine what time zone is in effect. # Use GMT if TZ is defined as null, local time if TZ undefined. # There's no portable way to find the system default timezone. $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = ($TZ eq 'GMT') ? gmtime($time) : localtime($time); # Hack to deal with 'PST8PDT' format of TZ # Note that this can't deal with all the esoteric forms, but it # does recognize the most common: [:]STDoff[DST[off][,rule]] if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){ $TZ = $isdst ? $4 : $1; } $TZ .= ' ' unless $TZ eq ''; $year += 1900; sprintf("%s %d, %2d %2d:%02d:%02d\n", @MoY[$mon], $mday, $year, $hour, $min, $sec); }