use strict;

use Cwd;
use File::Spec::Functions;
use File::Path ();
use Config;
use Symbol;

use constant DEVEL => getpwuid($>) eq 'stas';

my $VERSION = '1.02';

my @clean_files = ();

my $mp_gen = satisfy_mp_generation();
my $perl_gen = satisfy_perl_generation();

#warn "using mp gen: $mp_gen, perl gen: $perl_gen\n";

# currently we support only 5.8-perlio
if ($perl_gen eq '5.8') {
    die "Perl must be built with PerlIO support in order to use this module"
        unless $Config{useperlio};
}

build_prepare($mp_gen, $perl_gen);
warn "Goind to build against mod_perl/$mod_perl::VERSION Perl/$]\n";


my %prereq = (
    "Apache::Test" => "1.10", # ipv6 fixes
    "Devel::Peek"  => 0.96,
);

my %common_opts = (
    NAME         => "Apache::Peek",
    VERSION_FROM => "Peek.pm",
    XSPROTOARG   => '-noprototypes',
    DEFINE       => '-DMOD_PERL',
    clean        => { FILES => "@clean_files", },
    PREREQ_PM    => \%prereq,
);

if ($mp_gen == 1) {
    require Apache::src;
    my $inc = Apache::src->new->inc;
    die "Can't find mod_perl header files installed" unless $inc;

    require ExtUtils::MakeMaker;
    ExtUtils::MakeMaker::WriteMakefile(
        INC	     => $inc,
        LIBS         => [''],
        %common_opts,
    );

}
else {
    $prereq{mod_perl} = 1.9915;
    require ModPerl::MM;
    ModPerl::MM::WriteMakefile(
        %common_opts,
    );
}

sub build_prepare {
    my($mp_gen, $perl_gen) = @_;

    my $xs = "Peek.xs";
    my $pm = "Peek.pm";
    push @clean_files, ($pm, $xs);

    # now put together the build
    my %files = map { $_ => join '.', $_, "mp$mp_gen", "perl$perl_gen" }
        ($pm, $xs);

    unlink $xs if -e $xs;
    if (DEVEL and eval { symlink("", ""); 1 }) {
        # so that it's easier to modify/rebuild w/o re-running Makefile.PL
        symlink $files{$xs}, $xs 
            or die "Couldn't symlink $files{$xs} => $xs: $!";
    } else {
        # copy the xs file as is
        require File::Copy;
        File::Copy::copy($files{$xs}, $xs);
    }

    # adjust the version and glue the doc (open() for 5.005_03 support)
    my ($in, $out) = ($files{$pm}, $pm);
    my ($ifh, $ofh) = (Symbol::gensym(), Symbol::gensym());
    open $ifh,  "<$in"  or die "can't open $in: $!";
    open $ofh, ">$out" or die "can't open $out: $!";
    print $ofh "# WARNING: DO NOT EDIT THIS FILE, EDIT $in instead\n\n";
    while (<$ifh>) {
        s/(.*\$VERSION\s*=).*/$1 $VERSION;/;
        print $ofh $_;
    }
    print $ofh <DATA>;
    close $ifh;
    close $ofh;
}

sub test_configure {
    my $mp_gen = shift;

    if (eval { require Apache::TestMM }) {
        Apache::TestMM->import(qw(test clean));
        my @scripts = qw(t/TEST);
        # accept the configs from command line
        Apache::TestMM::filter_args();

        Apache::TestMM::generate_script($_) for @scripts;

        push @clean_files, @scripts;

        my $httpd;
        # mp2 already knows its 
        if ($mp_gen == 1) {
#        require Apache::test;
#        # can't really use get_test_params, since it may pick the wrong httpd
#        # must explicitly ask for the path to httpd
#        my %params = Apache::test->get_test_params;
#        $common_opts{macro}{APACHE} = $httpd;
        }
    } else {
        warn "***: You should install Apache::Test to do real testing\n";
        # META: soon on CPAN
        *MY::test = sub {
            return <<'EOF';
test : pure_all
	@echo \*** This test suite requires Apache::Test available from the
	@echo \*** mod_perl 2.0 sources or the httpd-test distribution.
EOF
        }
    }
}

sub satisfy_perl_generation {
      eval { require 5.8.0 }    ? "5.8"
    : eval { require 5.6.0 }    ? "5.6"
    : eval { require 5.005_03 } ? "5.5"
    : die "Perl version $] is unsupported";
}


# If a specific generation was passed as an argument,
#     if satisfied
#         return the same generation
#     else
#         die
# else @ARGV and %ENV will be checked for specific orders
#     if the specification will be found
#         if satisfied
#             return the specified generation
#         else
#             die
#     else if any mp generation is found
#              return it
#           else
#              die
sub satisfy_mp_generation {
    my $wanted = shift || wanted_mp_generation();

    unless ($wanted == 1 || $wanted == 2) {
        die "don't know anything about mod_perl generation: $wanted\n" .
            "currently supporting only generations 1 and 2";
    }

    my $selected = 0;

    if ($wanted == 1) {
        require_mod_perl();
        if ($mod_perl::VERSION >= 1.99) {
            # so we don't pick 2.0 version if 1.0 is wanted
            die "You don't seem to have mod_perl 1.0 installed";
        }
        $selected = 1;
    }
    elsif ($wanted == 2) {
        #warn "Looking for mod_perl 2.0";
        require Apache2;
        require_mod_perl();
        if ($mod_perl::VERSION < 1.99) {
            die "You don't seem to have mod_perl 2.0 installed";
        }
        $selected = 2;
    }
    else {
        require_mod_perl();
        $selected = $mod_perl::VERSION >= 1.99 ? 2 : 1;
        warn "Using $mod_perl::VERSION\n";
    }

    return $selected;
}

sub require_mod_perl {
    eval { require mod_perl };
    die "Can't find mod_perl installed\nThe error was: $@" if $@;
}

# the function looks at %ENV and Makefile.PL option to figure out
# whether a specific mod_perl generation was requested.
# It uses the following logic:
# via options:
# perl Makefile.PL MOD_PERL=2
# or via %ENV:
# env MOD_PERL=1 perl Makefile.PL
#
# return value is:
# 1 or 2 if the specification was found (mp 1 and mp 2 respectively)
# 0 otherwise
sub wanted_mp_generation {

    # check if we have a command line specification
    # flag: 0: unknown, 1: mp1, 2: mp2
    my $flag = 0;
    my @pass;
    while (@ARGV) {
        my $key = shift @ARGV;
        if ($key =~ /^MOD_PERL=(\d)$/) {
            $flag = $1;
        }
        else {
            push @pass, $key;
        }
    }
    @ARGV = @pass;

    # check %ENV
    my $env = exists $ENV{MOD_PERL} ? $ENV{MOD_PERL} : 0;

    # check for contradicting requirements
    if ($env && $flag && $flag != $env) {
        die <<EOF;
Can\'t decide which mod_perl version should be used, since you have
supplied contradicting requirements:
    enviroment variable MOD_PERL=$env
    Makefile.PL option  MOD_PERL=$flag
EOF
    }

    my $wanted = 0; 
    $wanted = 2 if $env == 2 || $flag == 2;
    $wanted = 1 if $env == 1 || $flag == 1;

    unless ($wanted) {
        # if still unknown try to require mod_perl.pm
        eval { require mod_perl };
        unless ($@) {
            $wanted = $mod_perl::VERSION >= 1.99 ? 2 : 1;
        }
    }

    return $wanted;
}

1;
__DATA__
__END__

=head1 NAME

Apache::Peek - A data debugging tool for the XS programmer (under mod_perl)

=head1 SYNOPSIS

        use Apache::Peek;
        Dump( $a );
        Dump( $a, 5 );
        DumpArray( 5, $a, $b, ... );

        # more functionality inherited from Devel::Peek

=head1 DESCRIPTION

C<Apache::Peek> is a sub-class of C<Devel::Peek>. The only difference
is that it overrides the stderr stream, to which C<Devel::Peek> sends
its output, and send the output to the client instead.

Note: The following table summarizes what parts of the
C<Devel::Peek>'s API are available, depending on the used Perl version
and configurations:

  5.005_0x                 all
  5.6.x                    only Dump()
  5.8.x (w/  -Duseperlio)  all
  5.8.x (w/o -Duseperlio)  none

Patches to complete the functionality under all configurations are
welcome.

C<Apache::Peek> works both with mod_perl 1.0 and 2.0.

See the C<Devel::Peek> manpage for a complete documentation.

=head1 AUTHOR

Hacking the mod_perl versions:

Doug MacEachern         dougm@pobox.com

Stas Bekman             stas@stason.org

Writing the original C<Devel::Peek>

Ilya Zakharevich	ilya@math.ohio-state.edu

=head1 Copyright

Copyright (c) 1995-98 Ilya Zakharevich. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Author of this software makes no claim whatsoever about suitability,
reliability, edability, editability or usability of this product, and
should not be kept liable for any damage resulting from the use of
it. If you can use it, you are in luck, if not, I should not be kept
responsible. Keep a handy copy of your backup tape at hand.

=head1 SEE ALSO

L<perlguts>, and L<perlguts>, again.

=cut