lib/DBIx/Class/CDBICompat/ColumnCase.pm

   1 package DBIx::Class::CDBICompat::ColumnCase;
   2
   3 use strict;
   4 use warnings;
   5 use NEXT;
   6
   7 sub _register_column_group {
   8   my ($class, $group, @cols) = @_;
   9   return $class->NEXT::ACTUAL::_register_column_group($group => map lc, @cols);
  10 }
  11
  12 sub _register_columns {
  13   my ($class, @cols) = @_;
  14   return $class->NEXT::ACTUAL::_register_columns(map lc, @cols);
  15 }
  16
  17 sub has_a {
  18   my ($class, $col, @rest) = @_;
  19   $class->NEXT::ACTUAL::has_a(lc($col), @rest);
  20   $class->delete_accessor($col);
  21   $class->mk_group_accessors('has_a' => $col);
  22   return 1;
  23 }
  24
  25 sub get_has_a {
  26   my ($class, $get, @rest) = @_;
  27   return $class->NEXT::ACTUAL::get_has_a(lc($get), @rest);
  28 }
  29
  30 sub store_has_a {
  31   my ($class, $set, @rest) = @_;
  32   return $class->NEXT::ACTUAL::store_has_a(lc($set), @rest);
  33 }
  34
  35 sub set_has_a {
  36   my ($class, $set, @rest) = @_;
  37   return $class->NEXT::ACTUAL::set_has_a(lc($set), @rest);
  38 }
  39
  40 sub get_column {
  41   my ($class, $get, @rest) = @_;
  42   return $class->NEXT::ACTUAL::get_column(lc($get), @rest);
  43 }
  44
  45 sub set_column {
  46   my ($class, $set, @rest) = @_;
  47   return $class->NEXT::ACTUAL::set_column(lc($set), @rest);
  48 }
  49
  50 sub store_column {
  51   my ($class, $set, @rest) = @_;
  52   return $class->NEXT::ACTUAL::store_column(lc($set), @rest);
  53 }
  54
  55 sub find_column {
  56   my ($class, $col) = @_;
  57   return $class->NEXT::ACTUAL::find_column(lc($col));
  58 }
  59
  60 sub _mk_group_accessors {
  61   my ($class, $type, $group, @fields) = @_;
  62   my %fields;
  63   $fields{$_} = 1 for @fields,
  64                     map lc, grep { !defined &{"${class}::${_}"} } @fields;
  65   return $class->NEXT::ACTUAL::_mk_group_accessors($type, $group, keys %fields);
  66 }
  67
  68 sub _cond_key {
  69   my ($class, $attrs, $key, @rest) = @_;
  70   return $class->NEXT::ACTUAL::_cond_key($attrs, lc($key), @rest);
  71 }
  72
  73 sub _cond_value {
  74   my ($class, $attrs, $key, @rest) = @_;
  75   return $class->NEXT::ACTUAL::_cond_value($attrs, lc($key), @rest);
  76 }
  77
  78 sub new {
  79   my ($class, $attrs, @rest) = @_;
  80   my %att;
  81   $att{lc $_} = $attrs->{$_} for keys %$attrs;
  82   return $class->NEXT::ACTUAL::new(\%att, @rest);
  83 }
  84
  85 1;