1
2# script tag not needed, just in for IIS Compat test
3<script runat=server>
4
5use lib '.';
6use T;
7use strict;
8use vars qw($Application $Session $t $Deep);
9use Carp qw(confess);
10
11$SIG{__DIE__} = \&confess;
12
13sub Application_OnStart {
14    $Application->{Start} = 1;
15}
16
17sub Session_OnStart {
18    $Session->{Count} = 10;
19}
20
21sub Script_OnStart {
22    $t = T->new();
23}
24
25sub Script_OnEnd {
26    $t && $t->done;
27}
28
29sub Script_OnFlush {
30    my $data = $Response->{BinaryRef};
31    for ( split(/\n/, $$data) ) {
32	next if /^\s*$/;
33	unless(/^((not )?ok)|\d+\.\.\d+/) {
34	    $t->eok(0, "Garbage in output: $_");
35	}
36    }
37}
38
39sub my::print {
40    my($args, $html) = @_;
41    print $html;
42}
43
44sub my::tag {
45    $t->eok($Deep, 'Deep tag not evaluated');
46}
47
48sub my::deeptag {
49    $t->ok;
50    $Deep++;
51}
52
53sub my::tag_check_value {
54    my $args = shift;
55    if($args->{value}) {
56	$t->ok;
57    } else {
58	$t->not_ok;
59    }
60}
61
62sub my::tag_check_value_ref {
63    my($args) = shift;
64    if(ref $args->{value}) {
65	$t->ok;
66    } else {
67	$t->not_ok;
68    }
69}
70
71sub my::tag_check_value_not_ref {
72    my($args) = shift;
73    if(ref $args->{value}) {
74	$t->not_ok;
75    } else {
76	$t->ok;
77    }
78}
79
80sub my::returnok {
81    $t->eok($_[1] eq 'ok', 'String return');
82}
83
84sub my::args {
85    $t->eok($_[0]->{ok}, $_[0]->{error} || "Argument passing");
86}
87
88# CLEANUP old state files from previous test script runs
89# so things like Application_OnStart may run
90if($0 =~ m|application\.t$|) {
91#    print STDERR "-- ASP State Initialization for Tests --\n";
92    die unless (-e '../t');
93    for my $dir ( qw(.cache .state) ) {
94	my @dirs = ($dir);
95	my @delete_dirs;
96	while(@dirs) {
97	    my $dir = shift @dirs;
98	    next unless -d $dir;
99	    opendir(DIR, $dir);
100	    for(readdir(DIR)) {
101		next if /^\.\.?$/;
102		$_ =~ tr///; # untaint
103		my $file = "$dir/$_";
104		if(-d $file) {
105		    push(@dirs, $file);
106		} elsif(-e $file) {
107		    unlink($file);
108		} else {
109		    die("$file does not exist, but we just read it");
110		}
111	    }
112	    unshift(@delete_dirs, $dir);
113	}
114	for(@delete_dirs) {
115	    rmdir($_);
116	}
117    }
118}
119
120# script tag not needed, just in for IIS Compat test
121</script>
122