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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
#!perl
use warnings;
use strict;
use Test::More tests => 27;
{
package My::Subclass::WithNew;
use base qw/Net::Twitter/;
sub new {
my $class = shift;
my $new = $class->SUPER::new(@_);
$new->{subclass_attribute} = 'attribute value';
return $new;
}
sub subclass_method { shift->{subclass_attribute} }
}
{
package My::Subclass::WithoutNew;
use base qw/Net::Twitter/;
sub subclass_method {
my $self = shift;
$self->{subclass_attribute} = shift if @_;
return $self->{subclass_attribute};
}
}
{
package My::Subclass::WithMoose;
use Moose;
extends 'Net::Twitter';
has subclass_attribute => ( is => 'rw', default => 'attribute value' );
sub subclass_method { shift->subclass_attribute(@_) }
}
{
package My::Subclass::ValidMoose;
use Moose;
extends 'Net::Twitter::Core';
with 'Net::Twitter::Role::API::REST';
has subclass_attribute => ( reader => 'subclass_method', default => 'attribute value' );
}
#diag 'subclass with new';
my $nt1 = My::Subclass::WithNew->new(username => 'me', password => 'secret');
isa_ok $nt1, 'Net::Twitter';
isa_ok $nt1, 'Net::Twitter::Core';
isa_ok $nt1, 'My::Subclass::WithNew';
can_ok $nt1, qw/subclass_method user_timeline search credentials/;
is $nt1->subclass_method, 'attribute value', 'has subclass attribute value';
is $nt1->password, 'secret', 'has base class attribute value';
#diag 'subclass without new';
my $nt2 = My::Subclass::WithoutNew->new(username => 'me', password => 'secret');
isa_ok $nt2, 'Net::Twitter';
isa_ok $nt2, 'Net::Twitter::Core';
isa_ok $nt2, 'My::Subclass::WithoutNew';
can_ok $nt2, qw/subclass_method user_timeline search credentials/;
is $nt2->subclass_method('test'), 'test', 'has subclass attribute value';
is $nt2->password, 'secret', 'has base class attribute value';
TODO: {
local $TODO = 'Moose classes should subclass Core, not Net::Twitter';
#diag 'Moose subclass';
my $nt3 = My::Subclass::WithMoose->new(username => 'me', password => 'secret');
isa_ok $nt3, 'Net::Twitter';
isa_ok $nt3, 'Net::Twitter::Core';
isa_ok $nt3, 'My::Subclass::WithMoose';
can_ok $nt3, qw/subclass_method user_timeline search credentials/;
is $nt3->subclass_method, 'attribute value', 'has subclass attribute value';
is $nt3->password, 'secret', 'has base class attribute value';
}
#diag 'valid Moose subclass';
my $nt4 = My::Subclass::ValidMoose->new(username => 'me', password => 'secret');
ok !$nt4->isa('Net::Twitter'), 'not created by Net::Twitter';
isa_ok $nt4, 'Net::Twitter::Core';
isa_ok $nt4, 'My::Subclass::ValidMoose';
can_ok $nt4, qw/subclass_method user_timeline credentials/;
is $nt4->subclass_method, 'attribute value', 'has subclass attribute value';
is $nt4->password, 'secret', 'has base class attribute value';
#diag 'class reuse';
is ref $nt1, ref My::Subclass::WithNew->new, 'reused anon class';
ok ref $nt1 ne ref $nt2, 'different subclasses have different anon classes';
ok ref $nt1 ne ref My::Subclass::WithNew->new(legacy => 0), 'different roles have different classes';
|
