t/000_recipes/moose_cookbook_meta_recipe2.t

   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::Labeled;
  14   use Mouse;
  15   extends 'Mouse::Meta::Attribute';
  16
  17   has label => (
  18       is        => 'rw',
  19       isa       => 'Str',
  20       predicate => 'has_label',
  21   );
  22
  23   package Mouse::Meta::Attribute::Custom::Labeled;
  24   sub register_implementation {'MyApp::Meta::Attribute::Labeled'}
  25
  26   package MyApp::Website;
  27   use Mouse;
  28
  29   has url => (
  30       metaclass => 'Labeled',
  31       is        => 'rw',
  32       isa       => 'Str',
  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 = '';
  45
  46       for my $name ( sort $self->meta->get_attribute_list ) {
  47           my $attribute = $self->meta->get_attribute($name);
  48
  49           if (   $attribute->isa('MyApp::Meta::Attribute::Labeled')
  50               && $attribute->has_label ) {
  51               $dump .= $attribute->label;
  52           }
  53           else {
  54               $dump .= $name;
  55           }
  56
  57           my $reader = $attribute->get_read_method;
  58           $dump .= ": " . $self->$reader . "\n";
  59       }
  60
  61       return $dump;
  62   }
  63
  64   package main;
  65
  66   my $app = MyApp::Website->new( url => "http://google.com", name => "Google" );
  67 }
  68
  69
  70
  71 # =begin testing
  72 {
  73 my $app = MyApp::Website->new( url => "http://google.com", name => "Google" );
  74 is(
  75     $app->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;