lib/DBIx/Class/CDBICompat/ColumnCase.pm

   1 package DBIx::Class::CDBICompat::ColumnCase;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class/;
   7
   8 sub _register_column_group {
   9   my ($class, $group, @cols) = @_;
  10   return $class->next::method($group => map lc, @cols);
  11 }
  12
  13 sub _register_columns {
  14   my ($class, @cols) = @_;
  15   return $class->next::method(map lc, @cols);
  16 }
  17
  18 sub has_a {
  19   my ($class, $col, @rest) = @_;
  20   $class->next::method(lc($col), @rest);
  21   $class->mk_group_accessors('inflated_column' => $col);
  22   return 1;
  23 }
  24
  25 sub has_many {
  26   my ($class, $rel, $f_class, $f_key, @rest) = @_;
  27   return $class->next::method($rel, $f_class, ( ref($f_key) ?
  28                                                           $f_key :
  29                                                           lc($f_key) ), @rest);
  30 }
  31
  32 sub get_inflated_column {
  33   my ($class, $get, @rest) = @_;
  34   return $class->next::method(lc($get), @rest);
  35 }
  36
  37 sub store_inflated_column {
  38   my ($class, $set, @rest) = @_;
  39   return $class->next::method(lc($set), @rest);
  40 }
  41
  42 sub set_inflated_column {
  43   my ($class, $set, @rest) = @_;
  44   return $class->next::method(lc($set), @rest);
  45 }
  46
  47 sub get_column {
  48   my ($class, $get, @rest) = @_;
  49   return $class->next::method(lc($get), @rest);
  50 }
  51
  52 sub set_column {
  53   my ($class, $set, @rest) = @_;
  54   return $class->next::method(lc($set), @rest);
  55 }
  56
  57 sub store_column {
  58   my ($class, $set, @rest) = @_;
  59   return $class->next::method(lc($set), @rest);
  60 }
  61
  62 sub find_column {
  63   my ($class, $col) = @_;
  64   return $class->next::method(lc($col));
  65 }
  66
  67 sub _mk_group_accessors {
  68   my ($class, $type, $group, @fields) = @_;
  69   #warn join(', ', map { ref $_ ? (@$_) : ($_) } @fields);
  70   my @extra;
  71   foreach (@fields) {
  72     my ($acc, $field) = ref $_ ? @$_ : ($_, $_);
  73     #warn "$acc ".lc($acc)." $field";
  74     next if defined &{"${class}::${acc}"};
  75     push(@extra, [ lc $acc => $field ]);
  76   }
  77   return $class->next::method($type, $group,
  78                                                      @fields, @extra);
  79 }
  80
  81 sub _cond_key {
  82   my ($class, $attrs, $key, @rest) = @_;
  83   return $class->next::method($attrs, lc($key), @rest);
  84 }
  85
  86 sub _cond_value {
  87   my ($class, $attrs, $key, @rest) = @_;
  88   return $class->next::method($attrs, lc($key), @rest);
  89 }
  90
  91 sub new {
  92   my ($class, $attrs, @rest) = @_;
  93   my %att;
  94   $att{lc $_} = $attrs->{$_} for keys %$attrs;
  95   return $class->next::method(\%att, @rest);
  96 }
  97
  98 1;