local-lib5/lib/perl5/MooseX/Types/VariantTable/Declare.pm

   1 #!/usr/bin/perl
   2
   3 package MooseX::Types::VariantTable::Declare;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Carp qw(croak);
   9
  10 use Sub::Exporter -setup => {
  11     exports => [qw(variant_method)],
  12     groups => {
  13         default => [qw(variant_method)],
  14     },
  15 };
  16
  17 use Moose::Meta::Method::VariantTable;
  18
  19 sub variant_method ($$$) {
  20         my ( $name, $type, $body ) = @_;
  21
  22         my $class = caller;
  23
  24         my $meta = $class->meta;
  25
  26         my $meta_method = $class->meta->get_method($name);
  27
  28         unless ( $meta_method ) {
  29         $meta_method = Moose::Meta::Method::VariantTable->new(
  30             name => $name,
  31             class => $meta,
  32             package_name => $class,
  33         );
  34
  35         $meta->add_method( $name => $meta_method );
  36         }
  37
  38         if ( $meta_method->isa("Moose::Meta::Method::VariantTable") ) {
  39                 $meta_method->add_variant( $type, $body );
  40         } else {
  41                 croak "Method '$name' is already defined";
  42         }
  43
  44         return $meta_method->body;
  45 }
  46
  47 __PACKAGE__
  48
  49 __END__
  50
  51 =pod
  52
  53 =head1 NAME
  54
  55 MooseX::Types::VariantTable::Declare - Declarative sugar for
  56 L<MooseX::Types::VariantTable> based methods.
  57
  58 =head1 SYNOPSIS
  59
  60     package Awesome;
  61     use Moose;
  62
  63     variant_method dance => Item => sub {
  64         # Item is the least derived type in the hierarchy,
  65         # every other type subtypes it
  66         # this is in effect a fallback
  67         return "fallback";
  68     };
  69
  70     # a more specific type
  71     variant_method dance => Ballerina => sub {
  72         my ( $self, $ballerina, @args ) = @_;
  73
  74         $ballerina; # a value that passed the TC named "Ballerina"
  75
  76         return "pretty!";
  77     };
  78
  79     # also works with objects
  80     variant_method dance => $type_object => sub { ... };
  81
  82 =head1 DESCRIPTION
  83
  84 This module provides declarative sugar for defining
  85 L<Moose::Meta::Method::VariantTable> methods in your L<Moose> classes and
  86 roles.
  87
  88 These methods have some semantics:
  89
  90 =head2 Declaration
  91
  92 The order of the declarations do not matter in most cases.
  93
  94 It is the type hierarchy that defines the order in which the constraints are
  95 checked and items dispatched.
  96
  97 However, in the case that two constraints without an explicit relationship
  98 between them (one is a subtype of the other) both accept the same value, the
  99 one that was declared earlier will win. There is no way around this issue, so
 100 be careful what types you use especially when mixing variants form many
 101 different sources.
 102
 103 Adding the same type to a variant table twice is an error.
 104
 105 =head2 Inheritence
 106
 107 When dispatching all of the subclass's variants will be tried before the
 108 superclass.
 109
 110 This allows shadowing of types from the superclass even using broader types.
 111
 112 =head2 Roles
 113
 114 ... are currently broken.
 115
 116 Don't use variant table methods in a role, unless that's the only definition,
 117 because in the future variant table merging will happen at role composition
 118 time in a role composition like way, so your code will not continue to work the
 119 same.
 120
 121 =back