t/003-apply.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 15;
   5 use Test::Exception;
   6
   7 do {
   8     package MyRole::Storage;
   9     use MooseX::Role::Parameterized;
  10     use Moose::Util::TypeConstraints;
  11
  12     parameter format => (
  13         is       => 'ro',
  14         isa      => (enum ['Dumper', 'Storable']),
  15         required => 1,
  16     );
  17
  18     parameter freeze_method => (
  19         is      => 'ro',
  20         isa     => 'Str',
  21         lazy    => 1,
  22         default => sub { "freeze_" . shift->format },
  23     );
  24
  25     parameter thaw_method => (
  26         is      => 'ro',
  27         isa     => 'Str',
  28         lazy    => 1,
  29         default => sub { "thaw_" . shift->format },
  30     );
  31
  32     role {
  33         my $p = shift;
  34         my $format = $p->format;
  35
  36         my ($freezer, $thawer);
  37
  38         if ($format eq 'Dumper') {
  39             require Data::Dumper;
  40             $freezer = \&Data::Dumper::Dumper;
  41             $thawer  = sub { eval "@_" };
  42
  43         }
  44         elsif ($format eq 'Storable') {
  45             require Storable;
  46             $freezer = \&Storable::nfreeze;
  47             $thawer  = \&Storable::thaw;
  48         }
  49         else {
  50             die "Unknown format ($format)";
  51         }
  52
  53         method $p->freeze_method => $freezer;
  54         method $p->thaw_method   => $thawer;
  55     };
  56 };
  57
  58 do {
  59     package MyClass::Dumper;
  60     use Moose;
  61     with 'MyRole::Storage' => {
  62         format => 'Dumper',
  63     };
  64 };
  65
  66 can_ok('MyClass::Dumper' => qw(freeze_Dumper thaw_Dumper));
  67 cant_ok('MyClass::Dumper' => qw(freeze_Storable thaw_Storable));
  68
  69 do {
  70     package MyClass::Storable;
  71     use Moose;
  72     with 'MyRole::Storage' => {
  73         format => 'Storable',
  74     };
  75 };
  76
  77 can_ok('MyClass::Storable' => qw(freeze_Storable thaw_Storable));
  78 cant_ok('MyClass::Storable' => qw(freeze_Dumper thaw_Dumper));
  79
  80 do {
  81     package MyClass::DumperRenamed;
  82     use Moose;
  83     with 'MyRole::Storage' => {
  84         format => 'Dumper',
  85         freeze_method => 'save',
  86         thaw_method   => 'load',
  87     };
  88 };
  89
  90 can_ok('MyClass::DumperRenamed' => qw(save load));
  91 cant_ok('MyClass::DumperRenamed' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable));
  92
  93 do {
  94     package MyClass::Both;
  95     use Moose;
  96     with 'MyRole::Storage' => { format => 'Dumper'   };
  97     with 'MyRole::Storage' => { format => 'Storable' };
  98 };
  99
 100 can_ok('MyClass::Both' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable));
 101
 102 do {
 103     package MyClass::Three;
 104     use Moose;
 105     with 'MyRole::Storage' => { format => 'Dumper'   };
 106     with 'MyRole::Storage' => { format => 'Storable' };
 107     with 'MyRole::Storage' => {
 108         format        => 'Storable',
 109         freeze_method => 'store',
 110         thaw_method   => 'dump',
 111     };
 112 };
 113
 114 can_ok('MyClass::Three' => qw(freeze_Dumper freeze_Storable thaw_Dumper thaw_Storable store dump));
 115
 116 throws_ok {
 117     package MyClass::Error::Required;
 118     use Moose;
 119     with 'MyRole::Storage';
 120 } qr/^Attribute \(format\) is required/;
 121
 122 throws_ok {
 123     package MyClass::Error::Invalid;
 124     use Moose;
 125     with 'MyRole::Storage' => {
 126         format => 'YAML',
 127     };
 128 } qr/^Attribute \(format\) does not pass the type constraint/;
 129
 130 sub cant_ok {
 131     local $Test::Builder::Level = $Test::Builder::Level + 1;
 132     my $instance = shift;
 133     for my $method (@_) {
 134         ok(!$instance->can($method), "$instance cannot $method");
 135     }
 136 }
 137