lib/SQL/Translator/Types.pm

   1 package SQL::Translator::Types;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Types - Type checking functions
   6
   7 =head1 SYNOPSIS
   8
   9     package Foo;
  10     use Moo;
  11     use SQL::Translator::Types qw(schema_obj);
  12
  13     has foo => ( is => 'rw', isa => schema_obj('Trigger') );
  14
  15 =head1 DESCRIPTIONS
  16
  17 This module exports fuctions that return coderefs suitable for L<Moo>
  18 C<isa> type checks.
  19 Errors are reported using L<SQL::Translator::Utils/throw>.
  20
  21 =cut
  22
  23 use strictures 1;
  24
  25 use SQL::Translator::Utils qw(throw);
  26 use Scalar::Util qw(blessed);
  27
  28 use Exporter qw(import);
  29 our @EXPORT_OK = qw(schema_obj);
  30
  31 =head1 FUNCTIONS
  32
  33 =head2 schema_obj($type)
  34
  35 Returns a coderef that checks that its arguments is an object of the
  36 class C<< SQL::Translator::Schema::I<$type> >>.
  37
  38 =cut
  39
  40 sub schema_obj {
  41     my ($class) = @_;
  42     my $name = lc $class;
  43     $class = 'SQL::Translator::Schema' . ($class eq 'Schema' ? '' : "::$class");
  44     return sub {
  45         throw("Not a $name object")
  46             unless blessed($_[0]) and $_[0]->isa($class);
  47     };
  48 }
  49
  50 1;