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