This file is indexed.

/usr/lib/perl5/Apache/Test.pm is in libapache2-mod-perl2 2.0.5-5ubuntu1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package Apache::Test;

use strict;
use warnings FATAL => 'all';

use Exporter ();
use Config;
use Apache::TestConfig ();
use Test qw/ok skip/;

BEGIN {
    # Apache::Test loads a bunch of mp2 stuff while getting itself
    # together.  because we need to choose one of mp1 or mp2 to load
    # check first (and we choose mp2) $mod_perl::VERSION == 2.0
    # just because someone loaded Apache::Test.  This Is Bad.  so,
    # let's try to correct for that here by removing mod_perl from
    # %INC after the above use() statements settle in.  nobody
    # should be relying on us loading up mod_perl.pm anyway...

    delete $INC{'mod_perl.pm'};
}

use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION %SubTests @SkipReasons);

$VERSION = '1.36';

my @need = qw(need_lwp need_http11 need_cgi need_access need_auth
              need_module need_apache need_min_apache_version
              need_apache_version need_perl need_min_perl_version
              need_min_module_version need_threads need_apache_mpm
              need_php need_php4 need_ssl need_imagemap need_cache_disk);

my @have = map { (my $need = $_) =~ s/need/have/; $need } @need;

@ISA = qw(Exporter);
@EXPORT = (qw(sok plan skip_reason under_construction need),
           @need, @have);

%SubTests = ();
@SkipReasons = ();

sub cp {
    my @l;
    for( my $i=1; (@l=caller $i)[0] eq __PACKAGE__; $i++ ) {};
    return wantarray ? @l : $l[0];
}

my $Config;
my %wtm;
sub import {
    my $class=$_[0];
    my $wtm=0;
    my @base_exp;
    my @exp;
    my %my_exports;
    undef @my_exports{@EXPORT};

    my ($caller,$f,$l)=cp;

    for( my $i=1; $i<@_; $i++ ) {
	if( $_[$i] eq '-withtestmore' ) {
	    $wtm=1;
	}
	elsif( $_[$i] eq ':DEFAULT' ) {
	    push @exp, $_[$i];
	    push @base_exp, $_[$i];
	}
	elsif( $_[$i] eq '!:DEFAULT' ) {
	    push @exp, $_[$i];
	    push @base_exp, $_[$i];
	}
	elsif( $_[$i]=~m@^[:/!]@ ) {
	    warn("Ignoring import spec $_[$i] ".
		 "at $f line $l\n")
	}
	elsif( exists $my_exports{$_[$i]} ) {
	    push @exp, $_[$i];
	}
	else {
	    push @base_exp, $_[$i];
	}
    }
    if (!@exp and @base_exp) {
	@exp=('!:DEFAULT');
    }
    elsif (@exp and !@base_exp) {
	@base_exp=('!:DEFAULT');
    }

    $wtm{$caller}=[$wtm,$f,$l] unless exists $wtm{$caller};

    warn("Ignoring -withtestmore due to a previous call ".
	 "($wtm{$caller}->[1]:$wtm{$caller}->[2]) without it ".
	 "at $f line $l\n")
	if $wtm{$caller}->[0]==0 and $wtm==1;

    $class->export_to_level(1, $class, @exp);

    push @base_exp, '!plan';
    if( $wtm{$caller}->[0] ) {	# -withtestmore
	eval <<"EVAL"
package $caller;
#line $l $f
use Test::More import=>\\\@base_exp;
EVAL
    }
    else {			# -withouttestmore
	eval <<"EVAL";
package $caller;
#line $l $f
use Test \@base_exp;
EVAL
    }
    die $@ if $@;
}

sub config {
    $Config ||= Apache::TestConfig->thaw->httpd_config;
}

my $Basic_config;

# config bits which doesn't require httpd to be found
sub basic_config {
    $Basic_config ||= Apache::TestConfig->thaw();
}

sub vars {
    @_ ? @{ config()->{vars} }{ @_ } : config()->{vars};
}

sub sok (&;$) {
    my $sub = shift;
    my $nok = shift || 1; #allow sok to have 'ok' within

    my ($caller,$f,$l)=cp;

    if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
	require Test::Builder;
	my $tb=Test::Builder->new;

	if (%SubTests and not $SubTests{ 1+$tb->current_test }) {
	    $tb->skip("skipping this subtest") for (1..$nok);
	    return;
	}

	# trick ok() into reporting the caller filename/line when a
	# sub-test fails in sok()
	return eval <<EOE;
#line $l $f
    Test::More::ok(\$sub->());
EOE
    }
    else {
	if (%SubTests and not $SubTests{ $Test::ntest }) {
	    skip("skipping this subtest", 0) for (1..$nok);
	    return;
	}

	# trick ok() into reporting the caller filename/line when a
	# sub-test fails in sok()
	return eval <<EOE;
#line $l $f
    Test::ok(\$sub->());
EOE
    }
}

#so Perl's Test.pm can be run inside mod_perl
sub test_pm_refresh {
    my ($caller,$f,$l)=cp;

    if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
	require Test::Builder;
        my $builder = Test::Builder->new;

        $builder->reset;

        $builder->output(\*STDOUT);
        $builder->todo_output(\*STDOUT);

        # this is STDOUT because Test::More seems to put
        # most of the stuff we want on STDERR, so it ends
        # up in the error_log instead of where the user can
        # see it.   consider leaving it alone based on
        # later user reports.
        $builder->failure_output(\*STDOUT);
    }
    else {                                                # -withouttestmore
	unless (exists $wtm{$caller}) {
	    warn "You forgot to 'use Apache::Test' in package $caller\n";
	    $wtm{$caller}=[0,$f,$l];
	}
	if (defined &Test::_reset_globals) {
	    Test::_reset_globals();
	    # Test.pm uses $TESTOUT=*STDOUT{IO}. We cannot do that
	    # due to the way SetupEnv works.
	    $Test::TESTOUT = \*STDOUT;
	}
	else {
	    $Test::TESTOUT = \*STDOUT;
	    $Test::planned = 0;
	    $Test::ntest = 1;
	    %Test::todo = ();
	}
    }
}

sub init_test_pm {
    my $r = shift;

    # needed to load Apache2::RequestRec::TIEHANDLE
    eval {require Apache2::RequestIO};
    if (defined &Apache2::RequestRec::TIEHANDLE) {
        untie *STDOUT;
        tie *STDOUT, $r;
        require Apache2::RequestRec; # $r->pool
        require APR::Pool;
        $r->pool->cleanup_register(sub { untie *STDOUT });
    }
    else {
        $r->send_http_header; #1.xx
    }

    $r->content_type('text/plain');
}

sub plan {
    init_test_pm(shift) if ref $_[0];
    test_pm_refresh();

    # extending Test::plan's functionality, by using the optional
    # single value in @_ coming after a ballanced %hash which
    # Test::plan expects
    if (@_ % 2) {
        my $condition = pop @_;
        my $ref = ref $condition;
        my $meets_condition = 0;
        if ($ref) {
            if ($ref eq 'CODE') {
                #plan tests $n, \&has_lwp
                $meets_condition = $condition->();
            }
            elsif ($ref eq 'ARRAY') {
                #plan tests $n, [qw(php4 rewrite)];
                $meets_condition = need_module($condition);
            }
            else {
                die "don't know how to handle a condition of type $ref";
            }
        }
        else {
            # we have the verdict already: true/false
            $meets_condition = $condition ? 1 : 0;
        }

        # trying to emulate a dual variable (ala errno)
        unless ($meets_condition) {
            my $reason = join ', ',
              @SkipReasons ? @SkipReasons : "no reason given";
            print "1..0 # skipped: $reason\n";
            @SkipReasons = (); # reset
            exit; #XXX: Apache->exit
        }
    }
    @SkipReasons = (); # reset

    my ($caller,$f,$l)=cp;

    %SubTests=();
    if (my $subtests=$ENV{HTTPD_TEST_SUBTESTS}) {
	%SubTests=map { $_, 1 } split /\s+/, $subtests;
    }

    if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
	Test::More::plan(@_);
    }
    else {                                                # -withouttestmore
	unless (exists $wtm{$caller}) {
	    warn "You forgot to 'use Apache::Test' in package $caller\n";
	    $wtm{$caller}=[0,$f,$l];
	}
	Test::plan(@_);
    }

    # add to Test.pm verbose output
    print "# Using Apache/Test.pm version $VERSION\n";
}

sub need_http11 {
    require Apache::TestRequest;
    if (Apache::TestRequest::install_http11()) {
        return 1;
    }
    else {
        push @SkipReasons,
           "LWP version 5.60+ required for HTTP/1.1 support";
        return 0;
    }
}

sub need_ssl {
    my $vars = vars();
    need_module([$vars->{ssl_module_name}, 'Net::SSL']);
}

sub need_lwp {
    require Apache::TestRequest;
    if (Apache::TestRequest::has_lwp()) {
        return 1;
    }
    else {
        push @SkipReasons, "libwww-perl is not installed";
        return 0;
    }
}

sub need {
    my $need_all = 1;
    for my $cond (@_) {
        if (ref $cond eq 'HASH') {
            while (my($reason, $value) = each %$cond) {
                $value = $value->() if ref $value eq 'CODE';
                next if $value;
                push @SkipReasons, $reason;
                $need_all = 0;
            }
        }
        elsif ($cond =~ /^(0|1)$/) {
            $need_all = 0 if $cond == 0;
        }
        else {
            $need_all = 0 unless need_module($cond);
        }
    }
    return $need_all;

}

sub need_module {
    my $cfg = config();

    my @modules = grep defined $_,
        ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;

    my @reasons = ();
    for (@modules) {
        if (/^[a-z0-9_.]+$/) {
            my $mod = $_;
            $mod .= '.c' unless $mod =~ /\.c$/;
            next if $cfg->{modules}->{$mod};
            $mod = 'mod_' . $mod unless $mod =~ /^mod_/;
            next if $cfg->{modules}->{$mod};
            if (exists $cfg->{cmodules_disabled}->{$mod}) {
                push @reasons, $cfg->{cmodules_disabled}->{$mod};
                next;
            }
        }
        die "bogus module name $_" unless /^[\w:.]+$/;

        # if the module was explicitly passed with a .c extension,
        # do not try to eval it as a Perl module
        my $not_found = 1;
        unless (/\.c$/) {
            eval "require $_";
            $not_found = 0 unless $@;
            #print $@ if $@;
        }
        push @reasons, "cannot find module '$_'" if $not_found;

    }
    if (@reasons) {
        push @SkipReasons, @reasons;
        return 0;
    }
    else {
        return 1;
    }
}

sub need_min_perl_version {
    my $version = shift;

    return 1 if $] >= $version;

    push @SkipReasons, "perl >= $version is required";
    return 0;
}

# currently supports only perl modules
sub need_min_module_version {
    my($module, $version) = @_;

    # need_module requires the perl module
    return 0 unless need_module($module);

    # support dev versions like 0.18_01
    return 1
        if eval { no warnings qw(numeric); $module->VERSION($version) };

    push @SkipReasons, "$module version $version or higher is required";
    return 0;
}

sub need_cgi {
    return _need_multi(qw(cgi.c cgid.c));
}

sub need_cache_disk {
    return _need_multi(qw(cache_disk.c disk_cache.c));
}


sub need_php {
    return _need_multi(qw(php4 php5 sapi_apache2.c));
}

sub need_php4 {
    return _need_multi(qw(php4 sapi_apache2.c));
}

sub need_access {
    return _need_multi(qw(access authz_host));
}

sub need_auth {
    return _need_multi(qw(auth auth_basic));
}

sub need_imagemap {
    return need_module("imagemap") || need_module("imap");
}

sub _need_multi {

    my @check = @_;

    my $rc = 0;

    {
        local @SkipReasons;

        foreach my $module (@check) {
          $rc ||= need_module($module);
        }
    }

    my $reason = join ' or ', @check;

    push @SkipReasons, "cannot find one of $reason"
        unless $rc;

    return $rc;
}

sub need_apache {
    my $version = shift;
    my $cfg = Apache::Test::config();
    my $rev = $cfg->{server}->{rev};

    if ($rev == $version) {
        return 1;
    }
    else {
        push @SkipReasons,
          "apache version $version required, this is version $rev";
        return 0;
    }
}

sub need_min_apache_version {
    my $wanted = shift;
    my $cfg = Apache::Test::config();
    (my $current) = $cfg->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;

    if (normalize_vstring($current) < normalize_vstring($wanted)) {
        push @SkipReasons,
          "apache version $wanted or higher is required," .
          " this is version $current";
        return 0;
    }
    else {
        return 1;
    }
}

sub need_apache_version {
    my $wanted = shift;
    my $cfg = Apache::Test::config();
    (my $current) = $cfg->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;

    if (normalize_vstring($current) != normalize_vstring($wanted)) {
        push @SkipReasons,
          "apache version $wanted or higher is required," .
          " this is version $current";
        return 0;
    }
    else {
        return 1;
    }
}

sub need_apache_mpm {
    my $wanted = shift;
    my $cfg = Apache::Test::config();
    my $current = $cfg->{server}->{mpm};

    if ($current ne $wanted) {
        push @SkipReasons,
          "apache $wanted mpm is required," .
          " this is the $current mpm";
        return 0;
    }
    else {
        return 1;
    }
}

sub config_enabled {
    my $key = shift;
    defined $Config{$key} and $Config{$key} eq 'define';
}

sub need_perl_iolayers {
    if (my $ext = $Config{extensions}) {
        #XXX: better test?  might need to test patchlevel
        #if support depends bugs fixed in bleedperl
        return $ext =~ m:PerlIO/scalar:;
    }
    0;
}

sub need_perl {
    my $thing = shift;
    #XXX: $thing could be a version
    my $config;

    my $have = \&{"need_perl_$thing"};
    if (defined &$have) {
        return 1 if $have->();
    }
    else {
        for my $key ($thing, "use$thing") {
            if (exists $Config{$key}) {
                $config = $key;
                return 1 if config_enabled($key);
            }
        }
    }

    push @SkipReasons, $config ?
      "Perl was not built with $config enabled" :
        "$thing is not available with this version of Perl";

    return 0;
}

sub need_threads {
    my $status = 1;

    # check APR support
    my $build_config = Apache::TestConfig->modperl_build_config;

    if ($build_config) {
        my $apr_config = $build_config->get_apr_config();
        unless ($apr_config->{HAS_THREADS}) {
            $status = 0;
            push @SkipReasons, "Apache/APR was built without threads support";
        }
    }

    # check Perl's useithreads
    my $key = 'useithreads';
    unless (exists $Config{$key} and config_enabled($key)) {
        $status = 0;
        push @SkipReasons, "Perl was not built with 'ithreads' enabled";
    }

    return $status;
}

sub under_construction {
    push @SkipReasons, "This test is under construction";
    return 0;
}

sub skip_reason {
    my $reason = shift || 'no reason specified';
    push @SkipReasons, $reason;
    return 0;
}

# normalize Apache-style version strings (2.0.48, 0.9.4)
# for easy numeric comparison.  note that 2.1 and 2.1.0
# are considered equivalent.
sub normalize_vstring {

    my @digits = shift =~ m/(\d+)\.?(\d*)\.?(\d*)/;

    return join '', map { sprintf("%03d", $_ || 0) } @digits;
}

# have_ functions are the same as need_ but they don't populate
# @SkipReasons
for my $func (@have) {
    no strict 'refs';
    (my $real_func = $func) =~ s/^have_/need_/;
    *$func = sub {
        # be nice to poor souls calling functions with $_ argument in
        # the foreach loop, etc.!
        local $_;
        local @SkipReasons;
        return $real_func->(@_);
    };
}

package Apache::TestToString;

Apache::Test->import('!:DEFAULT');

sub TIEHANDLE {
    my $string = "";
    bless \$string;
}

sub PRINT {
    my $string = shift;
    $$string .= join '', @_;
}

sub start {
    tie *STDOUT, __PACKAGE__;
    Apache::Test::test_pm_refresh();
}

sub finish {
    my $s;
    {
        my $o = tied *STDOUT;
        $s = $$o;
    }
    untie *STDOUT;
    $s;
}

1;
__END__


=head1 NAME

Apache::Test - Test.pm wrapper with helpers for testing Apache

=head1 SYNOPSIS

    use Apache::Test;

=head1 DESCRIPTION

B<Apache::Test> is a wrapper around the standard C<Test.pm> with
helpers for testing an Apache server.

=head1 FUNCTIONS

=over 4

=item plan

This function is a wrapper around C<Test::plan>:

    plan tests => 3;

just like using Test.pm, plan 3 tests.

If the first argument is an object, such as an C<Apache::RequestRec>
object, C<STDOUT> will be tied to it. The C<Test.pm> global state will
also be refreshed by calling C<Apache::Test::test_pm_refresh>. For
example:

    plan $r, tests => 7;

ties STDOUT to the request object C<$r>.

If there is a last argument that doesn't belong to C<Test::plan>
(which expects a balanced hash), it's used to decide whether to
continue with the test or to skip it all-together. This last argument
can be:

=over

=item * a C<SCALAR>

the test is skipped if the scalar has a false value. For example:

  plan tests => 5, 0;

But this won't hint the reason for skipping therefore it's better to
use need():

  plan tests => 5,
      need 'LWP',
           { "not Win32" => sub { $^O eq 'MSWin32'} };

see C<need()> for more info.

=item * an C<ARRAY> reference

need_module() is called for each value in this array. The test is
skipped if need_module() returns false (which happens when at least
one C or Perl module from the list cannot be found).

Watch out for case insensitive file systems or duplicate modules
with the same name.  I.E.  If you mean mod_env.c
   need_module('mod_env.c')
Not
   need_module('env')

=item * a C<CODE> reference

the tests will be skipped if the function returns a false value. For
example:

    plan tests => 5, need_lwp;

the test will be skipped if LWP is not available

=back

All other arguments are passed through to I<Test::plan> as is.

=item ok

Same as I<Test::ok>, see I<Test.pm> documentation.

=item sok

Allows one to skip a sub-test, controlled from the command line.  The
argument to sok() is a CODE reference or a BLOCK whose return value
will be passed to ok(). By default behaves like ok(). If all sub-tests
of the same test are written using sok(), and a test is executed as:

  % ./t/TEST -v skip_subtest 1 3

only sub-tests 1 and 3 will be run, the rest will be skipped.

=item skip

Same as I<Test::skip>, see I<Test.pm> documentation.

=item test_pm_refresh

Normally called by I<Apache::Test::plan>, this function will refresh
the global state maintained by I<Test.pm>, allowing C<plan> and
friends to be called more than once per-process.  This function is not
exported.

=back

Functions that can be used as a last argument to the extended plan().
Note that for each C<need_*> function there is a C<have_*> equivalent
that performs the exact same function except that it is designed to
be used outside of C<plan()>.  C<need_*> functions have the side effect
of generating skip messages, if the test is skipped.  C<have_*> functions
don't have this side effect.  In other words, use C<need_apache()>
with C<plan()> to decide whether a test will run, but C<have_apache()>
within test logic to adjust expectations based on older or newer
server versions.

=over

=item need_http11

  plan tests => 5, need_http11;

Require HTTP/1.1 support.

=item need_ssl

  plan tests => 5, need_ssl;

Require SSL support.

Not exported by default.

=item need_lwp

  plan tests => 5, need_lwp;

Require LWP support.

=item need_cgi

  plan tests => 5, need_cgi;

Requires mod_cgi or mod_cgid to be installed.

=item need_cache_disk

  plan tests => 5, need_cache_disk

Requires mod_cache_disk or mod_disk_cache to be installed.


=item need_php

  plan tests => 5, need_php;

Requires a PHP module to be installed (version 4 or 5).

=item need_php4

  plan tests => 5, need_php4;

Requires a PHP version 4 module to be installed.

=item need_imagemap

  plan tests => 5, need_imagemap;

Requires a mod_imagemap or mod_imap be installed

=item need_apache

  plan tests => 5, need_apache 2;

Requires Apache 2nd generation httpd-2.x.xx

  plan tests => 5, need_apache 1;

Requires Apache 1st generation (apache-1.3.xx)

See also C<need_min_apache_version()>.

=item need_min_apache_version

Used to require a minimum version of Apache.

For example:

  plan tests => 5, need_min_apache_version("2.0.40");

requires Apache 2.0.40 or higher.

=item need_apache_version

Used to require a specific version of Apache.

For example:

  plan tests => 5, need_apache_version("2.0.40");

requires Apache 2.0.40.

=item need_apache_mpm

Used to require a specific Apache Multi-Processing Module.

For example:

  plan tests => 5, need_apache_mpm('prefork');

requires the prefork MPM.

=item need_perl

  plan tests => 5, need_perl 'iolayers';
  plan tests => 5, need_perl 'ithreads';

Requires a perl extension to be present, or perl compiled with certain
capabilities.

The first example tests whether C<PerlIO> is available, the second
whether:

  $Config{useithread} eq 'define';

=item need_min_perl_version

Used to require a minimum version of Perl.

For example:

  plan tests => 5, need_min_perl_version("5.008001");

requires Perl 5.8.1 or higher.

=item need_module

  plan tests => 5, need_module 'CGI';
  plan tests => 5, need_module qw(CGI Find::File);
  plan tests => 5, need_module ['CGI', 'Find::File', 'cgid'];

Requires Apache C and Perl modules. The function accept a list of
arguments or a reference to a list.

In case of C modules, depending on how the module name was passed it
may pass through the following completions:

=over

=item 1 need_module 'proxy_http.c'

If there is the I<.c> extension, the module name will be looked up as
is, i.e. I<'proxy_http.c'>.

=item 2 need_module 'mod_cgi'

The I<.c> extension will be appended before the lookup, turning it into
I<'mod_cgi.c'>.

=item 3 need_module 'cgi'

The I<.c> extension and I<mod_> prefix will be added before the
lookup, turning it into I<'mod_cgi.c'>.

=back

=item need_min_module_version

Used to require a minimum version of a module

For example:

  plan tests => 5, need_min_module_version(CGI => 2.81);

requires C<CGI.pm> version 2.81 or higher.

Currently works only for perl modules.

=item need

  plan tests => 5,
      need 'LWP',
           { "perl >= 5.8.0 and w/ithreads is required" =>
             ($Config{useperlio} && $] >= 5.008) },
           { "not Win32"                 => sub { $^O eq 'MSWin32' },
             "foo is disabled"           => \&is_foo_enabled,
           },
           'cgid';

need() is more generic function which can impose multiple requirements
at once. All requirements must be satisfied.

need()'s argument is a list of things to test. The list can include
scalars, which are passed to need_module(), and hash references. If
hash references are used, the keys, are strings, containing a reason
for a failure to satisfy this particular entry, the values are the
condition, which are satisfaction if they return true. If the value is
0 or 1, it used to decide whether the requirements very satisfied, so
you can mix special C<need_*()> functions that return 0 or 1. For
example:

  plan tests => 1, need 'Compress::Zlib', 'deflate',
      need_min_apache_version("2.0.49");

If the scalar value is a string, different from 0 or 1, it's passed to
I<need_module()>.  If the value is a code reference, it gets executed
at the time of check and its return value is used to check the
condition. If the condition check fails, the provided (in a key)
reason is used to tell user why the test was skipped.

In the presented example, we require the presence of the C<LWP> Perl
module, C<mod_cgid>, that we run under perl E<gt>= 5.7.3 on Win32.

It's possible to put more than one requirement into a single hash
reference, but be careful that the keys will be different.

It's also important to mention to avoid using:

  plan tests => 1, requirement1 && requirement2;

technique. While test-wise that technique is equivalent to:

  plan tests => 1, need requirement1, requirement2;

since the test will be skipped, unless all the rules are satisfied,
it's not equivalent for the end users. The second technique, deploying
C<need()> and a list of requirements, always runs all the requirement
checks and reports all the missing requirements. In the case of the
first technique, if the first requirement fails, the second is not
run, and the missing requirement is not reported. So let's say all the
requirements are missing Apache modules, and a user wants to satisfy
all of these and run the test suite again. If all the unsatisfied
requirements are reported at once, she will need to rebuild Apache
once. If only one requirement is reported at a time, she will have to
rebuild Apache as many times as there are elements in the C<&&>
statement.

Also see plan().

=item under_construction

  plan tests => 5, under_construction;

skip all tests, noting that the tests are under construction

=item skip_reason

  plan tests => 5, skip_reason('my custom reason');

skip all tests.  the reason you specify will be given at runtime.
if no reason is given a default reason will be used.

=back

=head1 Additional Configuration Variables

=over

=item basic_config

  my $basic_cfg = Apache::Test::basic_config();
  $basic_cfg->write_perlscript($file, $content);

C<basic_config()> is similar to C<config()>, but doesn't contain any
httpd-specific information and should be used for operations that
don't require any httpd-specific knowledge.

=item config

  my $cfg = Apache::Test::config();
  my $server_rev = $cfg->{server}->{rev};
  ...

C<config()> gives an access to the configuration object.

=item vars

  my $serverroot = Apache::Test::vars->{serverroot};
  my $serverroot = Apache::Test::vars('serverroot');
  my($top_dir, $t_dir) = Apache::Test::vars(qw(top_dir t_dir));

C<vars()> gives an access to the configuration variables, otherwise
accessible as:

  $vars = Apache::Test::config()->{vars};

If no arguments are passed, the reference to the variables hash is
returned. If one or more arguments are passed the corresponding values
are returned.

=back

=head1 Test::More Integration

There are a few caveats if you want to use I<Apache::Test> with
I<Test::More> instead of the default I<Test> backend.  The first is
that I<Test::More> requires you to use its own C<plan()> function
and not the one that ships with I<Apache::Test>.  I<Test::More> also
defines C<ok()> and C<skip()> functions that are different, and
simply C<use>ing both modules in your test script will lead to redefined
warnings for these subroutines.

To assist I<Test::More> users we have created a special I<Apache::Test>
import tag, C<:withtestmore>, which will export all of the standard
I<Apache::Test> symbols into your namespace except the ones that collide
with I<Test::More>.

    use Apache::Test qw(:withtestmore);
    use Test::More;

    plan tests => 1;           # Test::More::plan()

    ok ('yes', 'testing ok');  # Test::More::ok()

Now, while this works fine for standard client-side tests
(such as C<t/basic.t>), the more advanced features of I<Apache::Test>
require using I<Test::More> as the sole driver behind the scenes.

Should you choose to use I<Test::More> as the backend for
server-based tests (such as C<t/response/TestMe/basic.pm>) you will
need to use the C<-withtestmore> action tag:

    use Apache::Test qw(-withtestmore);

    sub handler {

        my $r = shift;

        plan $r, tests => 1;           # Test::More::plan() with
                                       # Apache::Test features

        ok ('yes', 'testing ok');      # Test::More::ok()
    }

C<-withtestmore> tells I<Apache::Test> to use I<Test::More>
instead of I<Test.pm> behind the scenes.  Note that you are not
required to C<use Test::More> yourself with the C<-withtestmore>
option and that the C<use Test::More tests =E<gt> 1> syntax
may have unexpected results.

Note that I<Test::More> version 0.49, available within the
I<Test::Simple> 0.49 distribution on CPAN, or greater is required
to use this feature.

Because I<Apache:Test> was initially developed using I<Test> as
the framework driver, complete I<Test::More> integration is
considered experimental at this time - it is supported as best as
possible but is not guaranteed to be as stable as the default I<Test>
interface at this time.

=head1 Apache::TestToString Class

The I<Apache::TestToString> class is used to capture I<Test.pm> output
into a string.  Example:

    Apache::TestToString->start;

    plan tests => 4;

    ok $data eq 'foo';

    ...

    # $tests will contain the Test.pm output: 1..4\nok 1\n...
    my $tests = Apache::TestToString->finish;

=head1 SEE ALSO

The Apache-Test tutorial:
L<http://perl.apache.org/docs/general/testing/testing.html>.

L<Apache::TestRequest|Apache::TestRequest> subclasses LWP::UserAgent and
exports a number of useful functions for sending request to the Apache test
server. You can then test the results of those requests.

Use L<Apache::TestMM|Apache::TestMM> in your F<Makefile.PL> to set up your
distribution for testing.

=head1 AUTHOR

Doug MacEachern with contributions from Geoffrey Young, Philippe
M. Chiasson, Stas Bekman and others.

Questions can be asked at the test-dev <at> httpd.apache.org list
For more information see: http://httpd.apache.org/test/.

=cut