File: TestComputer.pm

package info (click to toggle)
libdbix-class-perl 0.082844-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 5,320 kB
  • sloc: perl: 27,215; sql: 322; sh: 29; makefile: 16
file content (39 lines) | stat: -rw-r--r-- 984 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
package DBICTest::DynamicForeignCols::TestComputer;

use warnings;
use strict;

use base 'DBIx::Class::Core';

__PACKAGE__->table('TestComputer');
__PACKAGE__->add_columns(qw( test_id ));
__PACKAGE__->_add_join_column({ class => 'DBICTest::DynamicForeignCols::Computer', method => 'computer' });
__PACKAGE__->set_primary_key('test_id', 'computer_id');
__PACKAGE__->belongs_to(computer => 'DBICTest::DynamicForeignCols::Computer', 'computer_id');

###
### This is a pathological case lifted from production. Yes, there is code
### like this in the wild
###
sub _add_join_column {
   my ($self, $params) = @_;

   my $class = $params->{class};
   my $method = $params->{method};

   $self->ensure_class_loaded($class);

   my @class_columns = $class->primary_columns;

   if (@class_columns = 1) {
      $self->add_columns( "${method}_id" );
   } else {
      my $i = 0;
      for (@class_columns) {
         $i++;
         $self->add_columns( "${method}_${i}_id" );
      }
   }
}

1;