basic Apache2 fake modules

git-svn-id: https://cle.sk/repos/pub/cpan/Test-Environment/trunk@310 b0c1b02c-7ba7-4df7-b273-855bf36df2ab

lib/Test/Environment/Plugin/Apache2.pm

@@ -0,0 +1,43 @@
+package Test::Environment::Plugin::Apache2;
+
+=head1 NAME
+
+Test::Environment::Plugin::Apache2 - simulate Apache2 modules
+
+=head1 SYNOPSIS
+
+	use Test::Environment qw{
+		Apache2
+	};
+
+
+=head1 DESCRIPTION
+
+This module will just sets:
+
+	unshift @INC, File::Spec->catdir(File::Basename::dirname(__FILE__), 'Apache');
+
+So that the fake Apache2 modules are found and loaded from there.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '0.01';
+
+use File::Basename qw();
+use File::Spec qw();
+
+unshift @INC, File::Spec->catdir(File::Basename::dirname(__FILE__), 'Apache2');
+
+1;
+
+
+__END__
+
+=head1 AUTHOR
+
+Jozef Kutej
+
+=cut

lib/Test/Environment/Plugin/Apache2/Filter.pm

@@ -0,0 +1,81 @@
+package # hide from CPAN indexer
+    Apache2::Filter;
+
+=head1 NAME
+
+Test::Environment::Plugin::Apache2::Apache2::Filter - fake Apache2::Filter for Test::Environment
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '0.01';
+
+use IO::String;
+use Carp::Clan ();
+
+use base 'Class::Accessor::Fast';
+=head1 PROPERTIES
+
+=cut
+
+__PACKAGE__->mk_accessors(qw{
+    ctx
+    data
+    max_buffer_size
+});
+
+=head1 METHODS
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new({
+        'data'            => '',
+        'request_rec'     => {},
+        'max_buffer_size' => 100,
+        @_,
+    });
+
+    if (ref $self->data eq 'SCALAR') {
+        $self->{'data'} = IO::String->new(${$self->data});
+    }
+    elsif (ref $self->data eq '') {
+        my $filename = $self->{'data'};
+        open($self->{'data'}, '<', $filename)
+            or die 'failed to open "'.$filename.'": '.$!;
+    }
+    elsif (eval { $self->data->can('read'); }) {
+    }
+    else {
+        Carp::Clan::croak('wrong "data" argument passed');
+    }
+
+    return $self;
+}
+
+sub read {
+    my $self   = shift;
+
+    my $buffer   = \$_[0];
+    my $len      =  $_[1];
+
+    $len = $self->max_buffer_size
+        if $len > $self->max_buffer_size;
+
+    return read($self->data, $$buffer, $len);
+}
+
+sub print {
+    my $self   = shift;
+
+    $self->{'data_for_next_filter'} .= @_;
+}
+
+1;

lib/Test/Environment/Plugin/Apache2/Log.pm

@@ -0,0 +1,28 @@
+package # hide from CPAN indexer
+    Apache2::Log;
+
+=head1 NAME
+
+Test::Environment::Plugin::Apache2::Apache2::Log - fake Apache2::Log for Test::Environment
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '0.01';
+
+use Log::Log4perl;
+use List::MoreUtils 'none';
+
+sub Apache2::RequestRec::log {
+    my $self   = shift;
+
+    return Log::Log4perl::get_logger();
+}
+
+1;

lib/Test/Environment/Plugin/Apache2/RequestRec.pm

@@ -0,0 +1,108 @@
+package # hide from CPAN indexer
+    Apache2::RequestRec;
+
+=head1 NAME
+
+Test::Environment::Plugin::Apache2::Apache2::RequestRec - fake Apache2::RequestRec for Test::Environment
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '0.01';
+
+use APR::Pool;
+use APR::Table;
+
+use base 'Class::Accessor::Fast';
+=head1 PROPERTIES
+
+=cut
+
+__PACKAGE__->mk_accessors(qw{
+    hostname
+    uri
+    apr_pool
+    args
+});
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new({
+        'apr_pool'    => APR::Pool->new,
+        @_,
+    });
+
+    # initilize all apr tables
+    foreach my $apt_table_name (qw(apr_table headers_in headers_out subprocess_env pnotes)) {
+        $self->{$apt_table_name} = APR::Table::make($self->apr_pool, 100)
+            if not defined $self->{$apt_table_name};
+    }
+
+    return $self;
+}
+
+=cut
+
+sub pnotes {
+    my $self      = shift;
+    my $note_name = shift;
+
+    if (@_ > 0) {
+        $self->{'pnotes'}->{$note_name} = shift;
+    }
+
+    return $self->{'pnotes'}->{$note_name};
+}
+
+=cut
+
+sub pnotes         { return shift->get_set('pnotes',         @_) };
+sub apr_table      { return shift->get_set('apr_table',      @_) };
+sub subprocess_env { return shift->get_set('subprocess_env', @_) };
+sub headers_in     { return shift->get_set('headers_in',     @_) };
+sub headers_out    { return shift->get_set('headers_out',    @_) };
+
+sub get_set {
+    my $self = shift;
+    my $name = shift;
+
+    if (@_ > 0) {
+        my $key_name = shift;
+        if (@_ > 0) {
+            $self->{$name}->add($key_name => shift);
+        }
+        return $self->{$name}->get($key_name);
+    }
+    else {
+        return $self->{$name};
+    }
+}
+
+sub Apache2::Filter::r {
+    my $self   = shift;
+    $self->request_rec(@_);
+}
+
+sub Apache2::Filter::request_rec {
+    my $self   = shift;
+
+    if (@_ > 0) {
+        $self->{'request_rec'} = shift;
+    }
+
+    if (ref $self->{'request_rec'} ne __PACKAGE__) {
+        $self->{'request_rec'} = bless $self->{'request_rec'}, __PACKAGE__;
+    }
+
+
+    return $self->{'request_rec'};
+}
+
+
+'writing on the wall';