t/000_recipes/meta/003_attribute_trait.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2;
   7 use Test::Exception;
   8
   9
  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
  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;
 104
 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');
 137