Commit | Line | Data |
e2a5f2c6 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
e606ae5f |
6 | use Test::More tests => 2; |
e2a5f2c6 |
7 | use Test::Exception; |
8 | |
e606ae5f |
9 | |
e2a5f2c6 |
10 | |
11 | ## attribute trait example |
12 | { |
13 | |
14 | package MyApp::Meta::Attribute::Trait::Labeled; |
15 | use Moose::Role; |
16 | |
17 | has label => ( |
18 | is => 'rw', |
19 | isa => 'Str', |
20 | predicate => 'has_label', |
21 | ); |
22 | |
23 | package Moose::Meta::Attribute::Custom::Trait::Labeled; |
24 | sub register_implementation { 'MyApp::Meta::Attribute::Trait::Labeled' } |
25 | |
26 | package MyApp::Website; |
27 | use Moose; |
28 | |
29 | has url => ( |
30 | traits => [qw/Labeled/], |
31 | isa => 'Str', |
32 | is => 'rw', |
33 | label => "The site's URL", |
34 | ); |
35 | |
36 | has name => ( |
37 | is => 'rw', |
38 | isa => 'Str', |
39 | ); |
40 | |
41 | sub dump { |
42 | my $self = shift; |
43 | |
44 | my $dump_value = ''; |
45 | |
46 | # iterate over all the attributes in $self |
47 | my %attributes = %{ $self->meta->get_attribute_map }; |
48 | foreach my $name (sort keys %attributes) { |
49 | |
50 | my $attribute = $attributes{$name}; |
51 | |
52 | # print the label if available |
53 | if ($attribute->does('MyApp::Meta::Attribute::Trait::Labeled') |
54 | && $attribute->has_label) { |
55 | $dump_value .= $attribute->label; |
56 | } |
57 | # otherwise print the name |
58 | else { |
59 | $dump_value .= $name; |
60 | } |
61 | |
62 | # print the attribute's value |
63 | my $reader = $attribute->get_read_method; |
64 | $dump_value .= ": " . $self->$reader . "\n"; |
65 | } |
66 | |
67 | return $dump_value; |
68 | } |
69 | |
70 | } |
71 | |
72 | my $app = MyApp::Website->new(url => "http://google.com", name => "Google"); |
73 | is($app->dump, q{name: Google |
74 | The site's URL: http://google.com |
75 | }, '... got the expected dump value'); |
76 | |
d9a8643f |
77 | # using the trait directly in a regular metaclass |
78 | { |
79 | package MyApp::Meta::Attribute::Labeled; |
80 | use Moose; |
81 | extends 'Moose::Meta::Attribute'; |
82 | with 'MyApp::Meta::Attribute::Trait::Labeled'; |
83 | |
84 | package Moose::Meta::Attribute::Custom::Labeled; |
85 | sub register_implementation { 'MyApp::Meta::Attribute::Labeled' } |
86 | |
87 | package MyApp::Website2; |
88 | use Moose; |
89 | |
90 | has url => ( |
91 | metaclass => 'Labeled', |
92 | isa => 'Str', |
93 | is => 'rw', |
94 | label => "The site's URL", |
95 | ); |
96 | |
97 | has name => ( |
98 | is => 'rw', |
99 | isa => 'Str', |
100 | ); |
101 | |
102 | sub dump { |
103 | my $self = shift; |
e2a5f2c6 |
104 | |
d9a8643f |
105 | my $dump_value = ''; |
106 | |
107 | # iterate over all the attributes in $self |
108 | my %attributes = %{ $self->meta->get_attribute_map }; |
109 | foreach my $name (sort keys %attributes) { |
110 | |
111 | my $attribute = $attributes{$name}; |
112 | |
113 | # print the label if available |
114 | if ($attribute->isa('MyApp::Meta::Attribute::Labeled') |
115 | && $attribute->has_label) { |
116 | $dump_value .= $attribute->label; |
117 | } |
118 | # otherwise print the name |
119 | else { |
120 | $dump_value .= $name; |
121 | } |
122 | |
123 | # print the attribute's value |
124 | my $reader = $attribute->get_read_method; |
125 | $dump_value .= ": " . $self->$reader . "\n"; |
126 | } |
127 | |
128 | return $dump_value; |
129 | } |
130 | |
131 | } |
132 | |
133 | my $app2 = MyApp::Website2->new(url => "http://google.com", name => "Google"); |
134 | is($app2->dump, q{name: Google |
135 | The site's URL: http://google.com |
136 | }, '... got the expected dump value'); |
e2a5f2c6 |
137 | |