1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
use strict;
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};
}
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";
|
