package Test::Mock::Apache2;

use strict;
use warnings;

our $VERSION = '0.02';

use Test::MockObject;

# ABSTRACT: Mock mod_perl2 objects when running outside of Apache


our $AP2_REQ;
our $AP2_REQ_UTIL;
our $APR_REQ_AP2;
our $APR_THROW_EXCEPTION = 0xDEADBEEF;

{

    my $COOKIE_JAR = {};

    sub cookie_jar {
        my $self = shift;

        if (@_) {
            $COOKIE_JAR = shift;
        }

        return $COOKIE_JAR;
    }

}

sub import {

    #arn "Init mocked objects...\n";
    init_mocked_objects();

    # XXX Apache2::Cookie
    my @modules_to_fake = qw(
        Apache2::Request
        Apache2::SubRequest
        Apache2::URI
    );

    #arn "Faking modules...\n";
    Test::MockObject->fake_module($_) for @modules_to_fake;
}


sub ap2_request {
    my $r = Test::MockObject->new();
    $r->fake_module('Apache2::RequestRec',
        hostname => sub {},
    );
    bless $r, 'Apache2::RequestRec';
    return $r;
}


sub apr_request_ap2 {
    my $r = Test::MockObject->new();
    $r->fake_module('APR::Request::Apache2',
        jar => sub {
            # Some primitive exception logic is needed
            # to simulate the cookie-containing-comma bug
            my $jar = Test::Mock::Apache2->cookie_jar();
            if (! ref $jar and ($jar == $APR_THROW_EXCEPTION)) {
                my $apr_req_err = Test::MockObject->new();
                $apr_req_err->fake_module('APR::Request::Error');
                $apr_req_err->set_always(jar => \&cookie_jar);
                return $apr_req_err;
            }
            bless $jar, "APR::Request::Cookie::Table";
        },
        handle => \&apr_request_ap2,
    );
    $r->fake_new('APR::Request::Apache2');
    bless $r, 'APR::Request::Apache2';
    return $r;
}


sub ap2_requestutil {
    my $ap2_ru = Test::MockObject->new();
    $ap2_ru->fake_module('Apache2::RequestUtil',
        request => \&ap2_request,
    );
}


sub init_mocked_objects {

    $AP2_REQ = ap2_request();
    $APR_REQ_AP2 = apr_request_ap2();
    $AP2_REQ_UTIL = ap2_requestutil();

}

1;


__END__
=pod

=head1 NAME

Test::Mock::Apache2 - Mock mod_perl2 objects when running outside of Apache

=head1 VERSION

version 0.02

=head1 SYNOPSIS

  use Test::Mock::Apache2;

  my $r = Apache2::RequestUtil->request();
  my $apr_req = APR::Request::Apache2->handle($r);

  ...

=head1 DESCRIPTION

Allows to work with C<Apache2::*> objects without a running modperl server.

The purpose of this class is to be able to run some minimal unit tests for
a code base that's hopelessly entangled with the Apache internals.

Current state is, to say the least, B<very incomplete>. Will be hopefully
expanded as the unit test suite grows.

=head1 METHODS

=head2 ap2_request

Return a mock L<Apache2::RequestRec> B<empty> object.

=head2 ap2_request_ap2

Return a mock L<APR::Request::Apache2> B<empty> object.

=head2 ap2_requestutil

Mocks the Apache2::RequestUtil> module to fake the C<+GlobalRequest>
option, so you can execute code like:

  my $r = Apache2::RequestUtil->request();

and get back an L<Apache2::RequestRec> object.
Uses L</ap2_request>.

=head2 init_mocked_objects

Creates the initial instances of the mocked objects
for the various C<Apache2::*> classes.

=head1 AUTHOR

Cosimo Streppone <cosimo@opera.com>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2011 by Opera Software ASA.

This is free software, licensed under:

  The (three-clause) BSD License

=cut

