convert from the bottom up
[dbsrgits/DBIx-Class.git] / 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