Skip Menu |
 

This queue is for tickets about the Apache-Singleton CPAN distribution.

Report information
The Basics
Id: 19775
Status: patched
Priority: 0/
Queue: Apache-Singleton

People
Owner: Nobody in particular
Requestors: manuelcorrea [...] citynet.net.ar
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: 0.10



Subject: Correction for mod_perl2
Download (untitled) / with headers
text/plain 786b
This code work in mod_perl2 package Apache::Singleton::Request; use strict; use vars qw($VERSION); $VERSION = '0.06'; use Apache::Singleton; use base qw(Apache::Singleton); BEGIN { use constant MP2 => eval { require mod_perl; $mod_perl::VERSION > 1.99 }; die "mod_perl is required to run this module: $@" if $@; if (MP2) { require Apache2::RequestUtil; } else { require Apache; } } sub _get_instance { my $class = shift; my $r = Apache2::RequestUtil->request; my $key = "apache_singleton_$class"; return $r->pnotes($key); } sub _set_instance { my($class, $instance) = @_; my $r = Apache2::RequestUtil->request; my $key = "apache_singleton_$class"; $r->pnotes($key => $instance); } best idea?? Manuel Correa - Rosario - Argentina
Download (untitled) / with headers
text/plain 670b
The attached patch adds real mod_perl2 support to Apache::Singleton. Summary of changes: Makefile.PL - figure out mod_perl version and set up PREREQ_PM accordingly. - for MP2, 1.9922 or later is required (2.0 RC5). This is when the great mod_perl2/Apache2 rename happened. lib/Apache/Singleton/Request.pm - make _get_instance()/_set_instance() work under both MP1 and MP2 the rest of the changes are to the test suite: - split out Apache, Mock::Apache into t/lib. - mock out mod_perl, mod_perl2, Apache2::RequestUtil - add t/05_request_mp2.t, which is identical to t/03_request.t, except it loads the dummy mod_perl2 to test MP2 bits of Apache::Singleton::Request
Download mp2.patch
text/x-diff 7.1k
diff --git a/MANIFEST b/MANIFEST index 6749a20..ddc7124 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,13 +1,19 @@ Changes -MANIFEST -Makefile.PL -README lib/Apache/Singleton.pm lib/Apache/Singleton/Process.pm lib/Apache/Singleton/Request.pm +Makefile.PL +MANIFEST +META.yml Module meta-data (added by MakeMaker) +README t/00_compile.t t/01_singleton.t t/02_multiclass.t t/03_request.t t/04_process.t -META.yml Module meta-data (added by MakeMaker) +t/05_request_mp2.t +t/lib/Apache.pm +t/lib/Apache2/RequestUtil.pm +t/lib/Mock/Apache.pm +t/lib/mod_perl.pm +t/lib/mod_perl2.pm diff --git a/Makefile.PL b/Makefile.PL index a9d6221..f112228 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,9 +1,50 @@ use ExtUtils::MakeMaker; + +my $mp_version = mod_perl_version(); + +my %prereq; + +if ($mp_version == 2) { + # the great mod_perl2/Apache2 rename happened in 1.99922 + $prereq{mod_perl2} = '1.9922'; +} +else { + $prereq{mod_perl} = 0; +} + WriteMakefile( 'NAME' => 'Apache::Singleton', 'VERSION_FROM' => 'lib/Apache/Singleton.pm', # finds $VERSION 'PREREQ_PM' => { Test::More => 0.32, - mod_perl => 0, + %prereq }, ); + +sub mod_perl_version { + # try to figure out what version of mod_perl is installed. + eval { + require mod_perl + }; + unless ($@) { + if ($mod_perl::VERSION >= 1.99) { + # this is mod_perl 2 prior to RC5 (1.99_21 or earlier). + # Later versions renamed to mod_perl2 + die "mod_perl 2.0.0 RC5 (1.9922) or later is required for this module (found $mod_perl::VERSION)"; + } + + return 1; + } + + eval { + require mod_perl2; + }; + unless ($@) { + return 2; + } + + # we didn't fine a supported version issue a warning, and assume version 2. + warn "no supported mod_perl version was found. assuming version 2\n"; + + return 2; +} diff --git a/lib/Apache/Singleton/Request.pm b/lib/Apache/Singleton/Request.pm index a9fe4dd..73622bc 100644 --- a/lib/Apache/Singleton/Request.pm +++ b/lib/Apache/Singleton/Request.pm @@ -8,11 +8,10 @@ use Apache::Singleton; use base qw(Apache::Singleton); BEGIN { - use constant MP2 => eval { require mod_perl; $mod_perl::VERSION > 1.99 }; - die "mod_perl is required to run this module: $@" if $@; + use constant MP2 => $mod_perl::VERSION >= 1.99 ? 1 : 0; if (MP2) { - require Apache::RequestUtil; + require Apache2::RequestUtil; } else { require Apache; @@ -21,14 +20,14 @@ BEGIN { sub _get_instance { my $class = shift; - my $r = Apache->request; + my $r = MP2 ? Apache2::RequestUtil->request : Apache->request; my $key = "apache_singleton_$class"; return $r->pnotes($key); } sub _set_instance { my($class, $instance) = @_; - my $r = Apache->request; + my $r = MP2 ? Apache2::RequestUtil->request : Apache->request; my $key = "apache_singleton_$class"; $r->pnotes($key => $instance); } diff --git a/t/01_singleton.t b/t/01_singleton.t index 0c13702..c10aee2 100644 --- a/t/01_singleton.t +++ b/t/01_singleton.t @@ -1,27 +1,13 @@ use strict; +use lib qw(t/lib lib); use Test::More tests => 2; - -package Apache; -sub request { - bless {}, 'Mock::Apache'; -} - -package Mock::Apache; -my %pnotes; -sub pnotes { - my($self, $key, $val) = @_; - $pnotes{$key} = $val if $val; - return $pnotes{$key}; -} +use Mock::Apache; package Printer; use base qw(Apache::Singleton); package main; { - local $ENV{MOD_PERL} = 1; - $INC{'Apache.pm'} = 1; # dummy - my $printer_a = Printer->instance; my $printer_b = Printer->instance; diff --git a/t/02_multiclass.t b/t/02_multiclass.t index 00ea255..011afca 100644 --- a/t/02_multiclass.t +++ b/t/02_multiclass.t @@ -1,21 +1,8 @@ use strict; +use lib qw(t/lib lib); use Test::More tests => 3; -$ENV{MOD_PERL} = 1; -$INC{'Apache.pm'} = 1; # dummy - -package Apache; -sub request { - bless {}, 'Mock::Apache'; -} - -package Mock::Apache; -my %pnotes; -sub pnotes { - my($self, $key, $val) = @_; - $pnotes{$key} = $val if $val; - return $pnotes{$key}; -} +use Mock::Apache; package Printer; use base qw(Apache::Singleton); diff --git a/t/03_request.t b/t/03_request.t index fbf0b8a..e98b82c 100644 --- a/t/03_request.t +++ b/t/03_request.t @@ -1,21 +1,8 @@ use strict; +use lib qw(t/lib lib); use Test::More tests => 4; - -$ENV{MOD_PERL} = 1; -$INC{'Apache.pm'} = 1; # dummy - -package Apache; -sub request { - bless {}, 'Mock::Apache'; -} - -package Mock::Apache; -my %pnotes; -sub pnotes { - my($self, $key, $val) = @_; - $pnotes{$key} = $val if $val; - return $pnotes{$key}; -} +use Mock::Apache; +use mod_perl; # simulate MP1 package Printer; use base qw(Apache::Singleton::Request); diff --git a/t/04_process.t b/t/04_process.t index d8466b1..539a21f 100644 --- a/t/04_process.t +++ b/t/04_process.t @@ -1,8 +1,7 @@ use strict; +use lib qw(t/lib lib); use Test::More tests => 4; - -$ENV{MOD_PERL} = 1; -$INC{'Apache.pm'} = 1; # dummy +use Mock::Apache; package Printer; use base qw(Apache::Singleton::Process); diff --git a/t/05_request_mp2.t b/t/05_request_mp2.t new file mode 100644 index 0000000..74709af --- /dev/null +++ b/t/05_request_mp2.t @@ -0,0 +1,28 @@ +use strict; +use lib qw(t/lib lib); +use Test::More tests => 4; +use Mock::Apache; +use mod_perl2; # simulate MP2 + +package Printer; +use base qw(Apache::Singleton::Request); + +package Printer::Device; +use base qw(Apache::Singleton::Request); + +package main; +my $printer_a = Printer->instance; +my $printer_b = Printer->instance; + +my $printer_d1 = Printer::Device->instance; +my $printer_d2 = Printer::Device->instance; + +is "$printer_a", "$printer_b", 'same printer'; +isnt "$printer_a", "$printer_d1", 'not same printer'; +is "$printer_d1", "$printer_d2", 'same printer'; + +$printer_a->{foo} = 'bar'; +is $printer_a->{foo}, $printer_b->{foo}, "attributes shared"; + + + diff --git a/t/lib/Apache.pm b/t/lib/Apache.pm new file mode 100644 index 0000000..07ad85a --- /dev/null +++ b/t/lib/Apache.pm @@ -0,0 +1,7 @@ +package Apache; + +sub request { + bless {}, 'Mock::Apache'; +} + +1; diff --git a/t/lib/Apache2/RequestUtil.pm b/t/lib/Apache2/RequestUtil.pm new file mode 100644 index 0000000..62da37a --- /dev/null +++ b/t/lib/Apache2/RequestUtil.pm @@ -0,0 +1,7 @@ +package Apache2::RequestUtil; + +sub request { + bless {}, 'Mock::Apache'; +} + +1; diff --git a/t/lib/Mock/Apache.pm b/t/lib/Mock/Apache.pm new file mode 100644 index 0000000..dbaaaa8 --- /dev/null +++ b/t/lib/Mock/Apache.pm @@ -0,0 +1,11 @@ +package Mock::Apache; + +my %pnotes; + +sub pnotes { + my($self, $key, $val) = @_; + $pnotes{$key} = $val if $val; + return $pnotes{$key}; +} + +1; diff --git a/t/lib/mod_perl.pm b/t/lib/mod_perl.pm new file mode 100644 index 0000000..dc536ed --- /dev/null +++ b/t/lib/mod_perl.pm @@ -0,0 +1,7 @@ +# dummy mod_perl package for tests +# just set mod_perl::VERSION +package mod_perl; + +our $VERSION = '1.27'; + +1; diff --git a/t/lib/mod_perl2.pm b/t/lib/mod_perl2.pm new file mode 100644 index 0000000..89f7d28 --- /dev/null +++ b/t/lib/mod_perl2.pm @@ -0,0 +1,7 @@ +# dummy mod_perl2 for tests. +# just set $mod_perl::VERSION to 2.00 +package mod_perl; + +our $VERSION = '2.00'; + +1;


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.