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