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