t/000_recipes/022_attribute_trait.t

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