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