diff --git a/lib/Test/Environment/Plugin/Apache2.pm b/lib/Test/Environment/Plugin/Apache2.pm new file mode 100644 index 0000000..75199df --- /dev/null +++ b/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 diff --git a/lib/Test/Environment/Plugin/Apache2/Filter.pm b/lib/Test/Environment/Plugin/Apache2/Filter.pm new file mode 100644 index 0000000..e730c97 --- /dev/null +++ b/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; diff --git a/lib/Test/Environment/Plugin/Apache2/Log.pm b/lib/Test/Environment/Plugin/Apache2/Log.pm new file mode 100644 index 0000000..558486a --- /dev/null +++ b/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; diff --git a/lib/Test/Environment/Plugin/Apache2/RequestRec.pm b/lib/Test/Environment/Plugin/Apache2/RequestRec.pm new file mode 100644 index 0000000..ba1d3ce --- /dev/null +++ b/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';