Commit | Line | Data |
85a83bed |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use Test::More 'no_plan'; |
5 | use Test::Exception; |
6 | $| = 1; |
7 | |
8 | |
9 | |
10 | # =begin testing SETUP |
11 | { |
12 | |
13 | package MyApp::Meta::Attribute::Trait::Labeled; |
14 | use Mouse::Role; |
15 | |
16 | has label => ( |
17 | is => 'rw', |
18 | isa => 'Str', |
19 | predicate => 'has_label', |
20 | ); |
21 | |
22 | package Mouse::Meta::Attribute::Custom::Trait::Labeled; |
23 | sub register_implementation {'MyApp::Meta::Attribute::Trait::Labeled'} |
24 | |
25 | package MyApp::Website; |
26 | use Mouse; |
27 | |
28 | has url => ( |
29 | traits => [qw/Labeled/], |
30 | is => 'rw', |
31 | isa => 'Str', |
32 | label => "The site's URL", |
33 | ); |
34 | |
35 | has name => ( |
36 | is => 'rw', |
37 | isa => 'Str', |
38 | ); |
39 | |
40 | sub dump { |
41 | my $self = shift; |
42 | |
43 | my $dump = ''; |
44 | |
cfa6d970 |
45 | for my $name ( sort $self->meta->get_attribute_list ) { |
cc08dff9 |
46 | my $attribute = $self->meta->get_attribute($name); |
85a83bed |
47 | |
48 | if ( $attribute->does('MyApp::Meta::Attribute::Trait::Labeled') |
49 | && $attribute->has_label ) { |
50 | $dump .= $attribute->label; |
51 | } |
52 | else { |
53 | $dump .= $name; |
54 | } |
55 | |
2a464664 |
56 | my $reader = $attribute->get_read_method_ref; |
b6c42ac0 |
57 | $dump .= ": " . $reader->($self) . "\n"; |
85a83bed |
58 | } |
59 | |
60 | return $dump; |
61 | } |
62 | |
63 | package main; |
64 | |
65 | my $app = MyApp::Website->new( url => "http://google.com", name => "Google" ); |
66 | } |
67 | |
68 | |
69 | |
70 | # =begin testing |
71 | { |
72 | my $app2 |
73 | = MyApp::Website->new( url => "http://google.com", name => "Google" ); |
74 | is( |
75 | $app2->dump, q{name: Google |
76 | The site's URL: http://google.com |
77 | }, '... got the expected dump value' |
78 | ); |
79 | } |
80 | |
81 | |
82 | |
83 | |
84 | 1; |