convert from the bottom up

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated / Types.pm

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
index 4e75aa2..c2b38da 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
@@ -1,44 +1,103 @@
 package # hide from PAUSE
   DBIx::Class::Storage::DBI::Replicated::Types;
 
-# DBIx::Class::Storage::DBI::Replicated::Types - Types used internally by
-# L<DBIx::Class::Storage::DBI::Replicated>
+use strict;
+use warnings;
+use Carp qw(confess);
 
-use MooseX::Types
-  -declare => [qw/BalancerClassNamePart Weight DBICSchema DBICStorageDBI/];
-use MooseX::Types::Moose qw/ClassName Str Num/;
+use Scalar::Util qw(blessed looks_like_number reftype);
 
-class_type 'DBIx::Class::Storage::DBI';
-class_type 'DBIx::Class::Schema';
+sub import {
+  my ($package, @methods) = @_;
+  my $caller = caller;
+  for my $method (@methods) {
+    { no strict;
+      *{"${caller}::${method}"} = sub {
+        my %args = @_;
+        sub { my $value = shift; &{$method}($value, %args) }
+      };
+    }
+  }
+}
 
-subtype DBICSchema, as 'DBIx::Class::Schema';
-subtype DBICStorageDBI, as 'DBIx::Class::Storage::DBI';
+sub error {
+  my ($default, $value, %args) = @_;
+  if(my $err = $args{err}) {
+    confess $err->($value);
+  } else {
+    confess $default;
+  }
+}
 
-subtype BalancerClassNamePart,
-  as ClassName;
+sub Defined {
+  error("Value $_[0] must be Defined", @_)
+    unless defined($_[0]);
+}
 
-coerce BalancerClassNamePart,
-  from Str,
-  via {
-    my $type = $_;
-    if($type=~m/^::/) {
-      $type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
-    }
-    Class::MOP::load_class($type);
-    $type;
-  };
-
-subtype Weight,
-  as Num,
-  where { $_ >= 0 },
-  message { 'weight must be a decimal greater than 0' };
-
-# AUTHOR
-#
-#  John Napiorkowski <john.napiorkowski@takkle.com>
-#
-# LICENSE
-#
-#  You may distribute this code under the same terms as Perl itself.
+sub UnDefined {
+  error("Value $_[0] must be UnDefined", @_)
+    unless !defined($_[0]);
+}
+
+sub Boolean {
+  error("$_[0] is not a valid Boolean", @_)
+    unless(!defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0');
+}
+
+sub Number {
+  error("weight must be a Number greater than or equal to 0, not $_[0]", @_)
+    unless(Defined(@_) && looks_like_number($_[0]));
+}
+
+sub Integer {
+  error("$_[0] must be an Integer", @_)
+    unless(Number(@_) && (int($_[0]) == $_[0]));
+}
+
+sub HashRef {
+  error("$_[0] must be a HashRef", @_)
+    unless(Defined(@_) && (reftype($_[0]) eq 'HASH'));
+}
+
+sub PositiveNumber {
+  error("value must be a Number greater than or equal to 0, not $_[0]", @_)
+    unless(Number(@_) && ($_[0] >= 0));
+}
+
+sub PositiveInteger {
+  error("Value must be a Number greater than or equal to 0, not $_[0]", @_)
+    unless(Integer(@_) && ($_[0] >= 0));
+}
+
+sub ClassName {
+  error("$_[0] is not a loaded Class", @_)
+    unless(Defined(@_) && ($_[0]->can('can')));
+}
+
+sub Object {
+  error("Value is not an Object", @_)
+    unless(Defined(@_) && blessed($_[0]));
+}
+
+sub DBICStorageDBI {
+  error("Need an Object of type DBIx::Class::Storage::DBI, not ".ref($_[0]), @_)
+    unless(Object(@_) && ($_[0]->isa('DBIx::Class::Storage::DBI')));
+}
+
+sub DBICStorageDBIReplicatedPool {
+  error("Need an Object of type DBIx::Class::Storage::DBI::Replicated::Pool, not ".ref($_[0]), @_)
+    unless(Object(@_) && ($_[0]->isa('DBIx::Class::Storage::DBI::Replicated::Pool')));
+}
+
+sub DBICSchema {
+  error("Need an Object of type DBIx::Class::Schema, not ".ref($_[0]), @_)
+    unless(Object(@_) && ($_[0]->isa('DBIx::Class::Schema')));
+}
+
+sub DoesDBICStorageReplicatedBalancer {
+  error("$_[0] does not do DBIx::Class::Storage::DBI::Replicated::Balancer", @_)
+    unless(Object(@_) && $_[0]->does('DBIx::Class::Storage::DBI::Replicated::Balancer') );
+}
 
 1;
+