lib/DBIx/Class/Storage/DBI/Replicated/Types.pm

   1 package # hide from PAUSE
   2   DBIx::Class::Storage::DBI::Replicated::Types;
   3
   4 use strict;
   5 use warnings;
   6 use Carp qw(confess);
   7
   8 use Scalar::Util qw(blessed looks_like_number reftype);
   9
  10 sub import {
  11   my ($package, @methods) = @_;
  12   my $caller = caller;
  13   for my $method (@methods) {
  14     { no strict;
  15       *{"${caller}::${method}"} = sub {
  16         my %args = @_;
  17         sub { my $value = shift; &{$method}($value, %args) }
  18       };
  19     }
  20   }
  21 }
  22
  23 sub error {
  24   my ($default, $value, %args) = @_;
  25   if(my $err = $args{err}) {
  26     confess $err->($value);
  27   } else {
  28     confess $default;
  29   }
  30 }
  31
  32 sub Defined {
  33   error("Value $_[0] must be Defined", @_)
  34     unless defined($_[0]);
  35 }
  36
  37 sub UnDefined {
  38   error("Value $_[0] must be UnDefined", @_)
  39     unless !defined($_[0]);
  40 }
  41
  42 sub Boolean {
  43   error("$_[0] is not a valid Boolean", @_)
  44     unless(!defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0');
  45 }
  46
  47 sub Number {
  48   error("weight must be a Number greater than or equal to 0, not $_[0]", @_)
  49     unless(Defined(@_) && looks_like_number($_[0]));
  50 }
  51
  52 sub Integer {
  53   error("$_[0] must be an Integer", @_)
  54     unless(Number(@_) && (int($_[0]) == $_[0]));
  55 }
  56
  57 sub HashRef {
  58   error("$_[0] must be a HashRef", @_)
  59     unless(Defined(@_) && (reftype($_[0]) eq 'HASH'));
  60 }
  61
  62 sub PositiveNumber {
  63   error("value must be a Number greater than or equal to 0, not $_[0]", @_)
  64     unless(Number(@_) && ($_[0] >= 0));
  65 }
  66
  67 sub PositiveInteger {
  68   error("Value must be a Number greater than or equal to 0, not $_[0]", @_)
  69     unless(Integer(@_) && ($_[0] >= 0));
  70 }
  71
  72 sub ClassName {
  73   error("$_[0] is not a loaded Class", @_)
  74     unless(Defined(@_) && ($_[0]->can('can')));
  75 }
  76
  77 sub Object {
  78   error("Value is not an Object", @_)
  79     unless(Defined(@_) && blessed($_[0]));
  80 }
  81
  82 sub DBICStorageDBI {
  83   error("Need an Object of type DBIx::Class::Storage::DBI, not ".ref($_[0]), @_)
  84     unless(Object(@_) && ($_[0]->isa('DBIx::Class::Storage::DBI')));
  85 }
  86
  87 sub DBICStorageDBIReplicatedPool {
  88   error("Need an Object of type DBIx::Class::Storage::DBI::Replicated::Pool, not ".ref($_[0]), @_)
  89     unless(Object(@_) && ($_[0]->isa('DBIx::Class::Storage::DBI::Replicated::Pool')));
  90 }
  91
  92 sub DBICSchema {
  93   error("Need an Object of type DBIx::Class::Schema, not ".ref($_[0]), @_)
  94     unless(Object(@_) && ($_[0]->isa('DBIx::Class::Schema')));
  95 }
  96
  97 sub DoesDBICStorageReplicatedBalancer {
  98   error("$_[0] does not do DBIx::Class::Storage::DBI::Replicated::Balancer", @_)
  99     unless(Object(@_) && $_[0]->does('DBIx::Class::Storage::DBI::Replicated::Balancer') );
 100 }
 101
 102 1;
 103