1#!/usr/bin/perl
2
3# for more accurate per request time accounting
4BEGIN {
5    eval "use Time::HiRes";
6    $Apache::ASP::QuickStartTime = eval { &Time::HiRes::time(); } || time();
7}
8
9# help section
10use File::Basename;
11use Getopt::Std;
12use Cwd;
13use Carp qw(confess);
14use Apache::ASP::CGI;
15
16=pod
17
18=head1 NAME
19
20asp-perl - Apache::ASP CGI and command line script processor
21
22=head1 SYNOPSIS
23
24asp-perl [-hsdb] [-f asp.conf] [-o directory] file1 @arguments file2 @arguments ...
25
26    -h  Help you are getting now!
27    -f  Specify an alternate configuration file other than ./asp.conf
28    -s  Setup $Session and $Application state for script.
29    -d  Set to debug code upon errors.
30    -b  Only return body of document, no headers.
31    -o  Output directory, writes to files there instead of STDOUT
32    -p  GlobalPackage config, what perl package are the scripts compiled in.
33
34=head1 DESCRIPTION
35
36This program will run Apache::ASP scripts from the command line.
37Each file that is specified will be run, and the
38$Request->QueryString() and $Request->Form() data will be
39initialized by the @arguments following the script file name.
40
41The @arguments will be written as space separated
42words, and will be initialized as an associate array where
43%arguments = @arguments.  As an example:
44
45 asp-perl file.asp key1 value1 key2 value2
46
47would be similar to calling the file.asp in a web environment like
48
49 /file.asp?key1=value1&key2=value2
50
51The asp.conf script will be read from the current directory
52for parameters that would be set with PerlSetVar normally under
53mod_perl.  For more information on how to configure the asp.conf
54file, please see < http://www.apache-asp.org/cgi.html >
55
56=head1 SEE ALSO
57
58perldoc Apache::ASP, and also http://www.apache-asp.org
59
60=head1 COPYRIGHT
61
62Copyright 1998-2004 Joshua Chamas, Chamas Enterprises Inc.
63
64This program is distributed under the GPL.  Please see the LICENSE
65file in the Apache::ASP distribution for more information.
66
67=cut
68
69$SIG{__DIE__} = \&confess;
70getopts('hsdbo:p:f:');
71
72if($opt_h || ! @ARGV) {
73    open(SCRIPT, $0) || die("can't open $0 for reading: $!");
74    my $script = join('', <SCRIPT>);
75    close SCRIPT;
76    $script =~ /=pod\s(.*?)=cut/s;
77    my $pod = $1;
78    $pod =~ s/\=head1 (\w+)/$1/isg;
79    $pod =~ s/DESCRIPTION.*//isg;
80    print $pod;
81    print "\"perldoc asp-perl\" or \"man asp-perl\" for more information\n\n";
82
83    exit;
84}
85
86if($opt_o && ! -e $opt_o) {
87    mkdir($opt_o, 0750) || die("can't mkdir $opt_o");
88}
89
90$Config = '';
91my $config_file = $opt_f || 'asp.conf';
92if(-e $config_file) {
93    # read in .asp to load %Config
94    open(CONFIG, $config_file) || die("can't open $config_file: $!");
95    $Config = join('', <CONFIG>);
96    close CONFIG;
97} else {
98    if($opt_f) {
99	die("Configuration file $opt_f does not exist!");
100    }
101}
102
103my $cwd = cwd();
104while(@ARGV) {
105    $cwd && (chdir($cwd) || die("can't chdir to $cwd"));
106    my $file = shift @ARGV;
107    my @script_args;
108
109    unless(-e $file) {
110	print "file $file does not exist\n";
111	next;
112    }
113
114    while(@ARGV) {
115	last if(-e $ARGV[0]);
116	push(@script_args, shift @ARGV);
117    }
118
119    if($opt_o) {
120	my $basename = basename($file);
121	open(STDOUT, ">$opt_o/$basename") || die("can't open $opt_o/$basename for writing");
122    }
123
124    $r = Apache::ASP::CGI->init($file, @script_args);
125    $0 = $file; # might need real $0 in $Config
126    eval $Config;
127    $@ && die("can't eval config error: $@");
128
129    $r->dir_config->set('NoState', 0) if $opt_s;
130    if($opt_d) {
131	$r->dir_config->set('Debug', -3);
132	$r->dir_config->set('CommandLine', 1);
133    }
134    if($opt_b) {
135	$r->dir_config->set('NoHeaders', 1);
136    }
137    if($opt_p) {
138	$r->dir_config->set('GlobalPackage', $opt_p);
139    }
140
141    for(keys %Config) {
142	$r->dir_config->set($_, $Config{$_});
143    }
144
145    &Apache::ASP::handler($r);
146
147    if($opt_o) {
148	close STDOUT;
149    }
150
151}
152
153
154