Reorder the accessor_name_for() check to get the more likely one first to
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / TempColumns.pm
1 package # hide from PAUSE
2     DBIx::Class::CDBICompat::TempColumns;
3
4 use strict;
5 use warnings;
6 use base qw/DBIx::Class/;
7
8 use Carp;
9
10 __PACKAGE__->mk_classdata('_temp_columns' => { });
11
12 sub _add_column_group {
13   my ($class, $group, @cols) = @_;
14   
15   return $class->next::method($group, @cols) unless $group eq 'TEMP';
16
17   my %new_cols = map { $_ => 1 } @cols;
18   my %tmp_cols = %{$class->_temp_columns};
19
20   for my $existing_col ( grep $new_cols{$_}, $class->columns ) {
21       # Already been declared TEMP
22       next if $tmp_cols{$existing_col};
23
24       carp "Declaring column $existing_col as TEMP but it already exists";
25   }
26
27   $class->_register_column_group($group => @cols);
28   $class->mk_group_accessors('temp' => @cols);
29
30   $class->_temp_columns({ %tmp_cols, %new_cols });
31 }
32
33 sub new {
34   my ($class, $attrs, @rest) = @_;
35
36   my $temp = $class->_extract_temp_data($attrs);
37
38   my $new = $class->next::method($attrs, @rest);
39
40   $new->set_temp($_, $temp->{$_}) for keys %$temp;
41
42   return $new;
43 }
44
45 sub _extract_temp_data {
46   my($self, $data) = @_;
47
48   my %temp;
49   foreach my $key (keys %$data) {
50     $temp{$key} = delete $data->{$key} if $self->_temp_columns->{$key};
51   }
52
53   return \%temp;
54 }
55
56 sub find_column {
57   my ($class, $col, @rest) = @_;
58   return $col if $class->_temp_columns->{$col};
59   return $class->next::method($col, @rest);
60 }
61
62 sub set {
63   my($self, %data) = @_;
64   
65   my $temp_data = $self->_extract_temp_data(\%data);
66   
67   $self->set_temp($_, $temp_data->{$_}) for keys %$temp_data;
68   
69   return $self->next::method(%data);
70 }
71
72 sub get_temp {
73   my ($self, $column) = @_;
74   $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
75   $self->throw_exception( "No such TEMP column '${column}'" ) unless $self->_temp_columns->{$column} ;
76   return $self->{_temp_column_data}{$column}
77     if exists $self->{_temp_column_data}{$column};
78   return undef;
79 }
80
81 sub set_temp {
82   my ($self, $column, $value) = @_;
83   $self->throw_exception( "No such TEMP column '${column}'" )
84     unless $self->_temp_columns->{$column};
85   $self->throw_exception( "set_temp called for ${column} without value" )
86     if @_ < 3;
87   return $self->{_temp_column_data}{$column} = $value;
88 }
89
90 sub has_real_column {
91   return 1 if shift->has_column(shift);
92 }
93
94 1;