Showing 23 changed files with 315 additions and 36 deletions
-1
lib/DBIx/Custom.pm
... ...
@@ -317,7 +317,6 @@ sub each_column {
317 317
         eval {$sth_columns = $self->dbh->column_info(undef, $schema, $table, '%')};
318 318
         next if $@;
319 319
         while (my $column_info = $sth_columns->fetchrow_hashref) {
320
-          $DB::single = 1;
321 320
           my $column = $column_info->{COLUMN_NAME};
322 321
           $self->$cb($table, $column, $column_info);
323 322
         }
t/_run/common-mysql-fullqualified.run
No changes.
+78
t/common-mysql-fullqualified.t
... ...
@@ -0,0 +1,78 @@
1
+use strict;
2
+use warnings;
3
+
4
+use FindBin;
5
+use lib "$FindBin::Bin/common_fullqualified";
6
+$ENV{DBIX_CUSTOM_TEST_RUN} = 1
7
+  if -f "$FindBin::Bin/run/common-mysql-fullqualified.run";
8
+$ENV{DBIX_CUSTOM_SKIP_MESSAGE} = 'mysql private test';
9
+
10
+
11
+
12
+use DBIx::Custom;
13
+{
14
+  package DBIx::Custom;
15
+  no warnings 'redefine';
16
+
17
+  my $table1 = 'dbix_custom.table1';
18
+  my $table2 = 'dbix_custom.table2';
19
+  my $table2_alias = 'dbix_custom.table2_alias';
20
+  my $table3 = 'dbix_custom.table3';
21
+  my $key1 = 'key1';
22
+  my $key2 = 'key2';
23
+  my $key3 = 'key3';
24
+  my $key4 = 'key4';
25
+  my $key5 = 'key5';
26
+  my $key6 = 'key6';
27
+  my $key7 = 'key7';
28
+  my $key8 = 'key8';
29
+  my $key9 = 'key9';
30
+  my $key10 = 'key10';
31
+
32
+  has table1 => $table1;
33
+  has table2 => $table2;
34
+  has table2_alias => $table2_alias;
35
+  has table3 => $table3;
36
+  has key1 => $key1;
37
+  has key2 => $key2;
38
+  has key3 => $key3;
39
+  has key4 => $key4;
40
+  has key5 => $key5;
41
+  has key6 => $key6;
42
+  has key7 => $key7;
43
+  has key8 => $key8;
44
+  has key9 => $key9;
45
+  has key10 => $key10;
46
+  has setup_model_args => sub { [database => 'dbix_custom', prefix => 1] };
47
+
48
+  my $date_typename = 'Date';
49
+  my $datetime_typename = 'Datetime';
50
+  
51
+  sub date_typename { lc $date_typename }
52
+  sub datetime_typename { lc $datetime_typename }
53
+
54
+  my $date_datatype = 9;
55
+  my $datetime_datatype = 11;
56
+  
57
+  sub date_datatype { lc $date_datatype }
58
+  sub datetime_datatype { lc $datetime_datatype }
59
+
60
+  no warnings 'redefine';
61
+  has dsn => "dbi:mysql:database=dbix_custom";
62
+  has user => 'dbix_custom';
63
+  has password => 'dbix_custom';
64
+  
65
+  sub create_table1 { "create table $table1 ($key1 varchar(255), $key2 varchar(255)) engine=InnoDB" }
66
+  sub create_table1_2 { "create table $table1 ($key1 varchar(255), $key2 varchar(255), "
67
+   . "$key3 varchar(255), key4 varchar(255), key5 varchar(255)) engine=InnoDB" }
68
+  sub create_table1_type { "create table $table1 ($key1 $date_typename, $key2 $datetime_typename) engine=InnoDB" }
69
+  sub create_table1_highperformance { "create table $table1 ($key1 varchar(255), $key2 varchar(255), "
70
+    . "$key3 varchar(255), $key4 varchar(255), $key5 varchar(255), $key6 varchar(255), $key7 varchar(255)) engine=InnoDB" }
71
+  sub create_table2 { "create table $table2 ($key1 varchar(255), $key3 varchar(255)) engine=InnoDB" }
72
+  sub create_table2_2 { "create table $table2 ($key1 varchar(255), $key2 varchar(255), $key3 varchar(255)) engine=InnoDB" }
73
+  sub create_table3 { "create table $table3 ($key1 varchar(255), $key2 varchar(255), $key3 varchar(255)) engine=InnoDB" }
74
+  sub create_table_reserved {
75
+    'create table `table` (`select` varchar(255), `update` varchar(255)) engine=InnoDB' }
76
+}
77
+
78
+require "$FindBin::Bin/common.t";
+37 -5
t/common.t
... ...
@@ -237,7 +237,38 @@ require MyDBI1;
237 237
   }
238 238
 
239 239
   sub list { shift->select; }
240
+
241
+  package MyModel2::dbix_custom::table1;
242
+
243
+  use strict;
244
+  use warnings;
245
+
246
+  use base 'MyModel2::Base1';
247
+
248
+  sub insert {
249
+    my ($self, $param) = @_;
250
+    
251
+    return $self->SUPER::insert($param);
252
+  }
253
+
254
+  sub list { shift->select; }
255
+
256
+  package MyModel2::dbix_custom::table2;
257
+
258
+  use strict;
259
+  use warnings;
260
+
261
+  use base 'MyModel2::Base1';
262
+
263
+  sub insert {
264
+    my ($self, $param) = @_;
265
+    
266
+    return $self->SUPER::insert($param);
267
+  }
268
+
269
+  sub list { shift->select; }
240 270
 }
271
+
241 272
 {
242 273
    package MyDBI5;
243 274
 
... ...
@@ -3930,6 +3961,7 @@ $dbi->setup_model(@$setup_model_args);
3930 3961
 $dbi->execute("insert into $table1 ($key1, $key2) values (1, 2)");
3931 3962
 $dbi->execute("insert into $table2 ($key1, $key3) values (1, 4)");
3932 3963
 $model = $dbi->model($table1);
3964
+$DB::single = 1;
3933 3965
 $result = $model->select(
3934 3966
   column => [
3935 3967
     $model->column($table2, {alias => u$table2_alias})
... ...
@@ -4800,13 +4832,13 @@ $dbi->insert({$key1 => 1, $key2 => 2}, table => $table1);
4800 4832
 $sql = <<"EOS";
4801 4833
 left outer join (
4802 4834
 select * from $table1 t1
4803
-where t1.$key2 = (
4804
-  select max(t2.$key2) from $table1 t2
4805
-  where t1.$key1 = t2.$key1
4806
-)
4835
+  where t1.$key2 = (
4836
+    select max(t2.$key2) from $table1 t2
4837
+    where t1.$key1 = t2.$key1
4838
+  )
4807 4839
 ) $table3 on $table1.$key1 = $table3.$key1
4808 4840
 EOS
4809
-$sql =~ s/\Qmain.table3/main_table3/g;
4841
+$sql =~ s/\Q.table3/_table3/g;
4810 4842
 $join = [$sql];
4811 4843
 $rows = $dbi->select(
4812 4844
   table => $table1,
+8 -1
t/common/MyModel8/table1.pm
... ...
@@ -1,7 +1,14 @@
1 1
 package MyModel8::table1;
2 2
 use MyModel8 -base;
3 3
 
4
-has join => sub { ['left join table2 table2_alias on table1.key1 = table2_alias.key1'] };
4
+has join => sub {
5
+  my $self = shift;
6
+  
7
+  my $alias = 'table2_alias';
8
+  $alias =~ s/\./_/g;
9
+  
10
+  return ["left join table2 $alias on table1.key1 = $alias.key1"];
11
+};
5 12
 
6 13
 
7 14
 1;
+13
t/common_fullqualified/MyModel1/dbix_custom/table1.pm
... ...
@@ -0,0 +1,13 @@
1
+package MyModel1::dbix_custom::table1;
2
+
3
+use DBIx::Custom::Model -base;
4
+
5
+sub insert {
6
+  my ($self, $param) = @_;
7
+  
8
+  return $self->SUPER::insert(param => $param);
9
+}
10
+
11
+sub list { shift->select; }
12
+
13
+1;
+17
t/common_fullqualified/MyModel1/dbix_custom/table2.pm
... ...
@@ -0,0 +1,17 @@
1
+package MyModel1::dbix_custom::table2;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'DBIx::Custom::Model';
7
+
8
+
9
+sub insert {
10
+  my ($self, $param) = @_;
11
+  
12
+  return $self->SUPER::insert(param => $param);
13
+}
14
+
15
+sub list { shift->select; }
16
+
17
+1;
+9
t/common_fullqualified/MyModel4/dbix_custom/table1.pm
... ...
@@ -0,0 +1,9 @@
1
+package MyModel4::dbix_custom::table1;
2
+
3
+use MyModel4 -base;
4
+
5
+has table => 'dbix_custom.table1';
6
+
7
+sub list { shift->select }
8
+
9
+1;
+8
t/common_fullqualified/MyModel4/dbix_custom/table2.pm
... ...
@@ -0,0 +1,8 @@
1
+package MyModel4::dbix_custom::table2;
2
+
3
+use base 'MyModel4';
4
+
5
+sub insert { shift->SUPER::insert(param => $_[0]) }
6
+sub list { shift->select }
7
+
8
+1;
+7
t/common_fullqualified/MyModel5/dbix_custom/table1.pm
... ...
@@ -0,0 +1,7 @@
1
+package MyModel5::dbix_custom::table1;
2
+
3
+use MyModel5 -base;
4
+
5
+has primary_key => sub { ['key1', 'key2'] };
6
+
7
+1;
+12
t/common_fullqualified/MyModel5/dbix_custom/table2.pm
... ...
@@ -0,0 +1,12 @@
1
+package MyModel5::dbix_custom::table2;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'MyModel5';
7
+
8
+__PACKAGE__->attr(table => 'dbix_custom.table2');
9
+
10
+__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
11
+
12
+1;
+13
t/common_fullqualified/MyModel5/dbix_custom/table3.pm
... ...
@@ -0,0 +1,13 @@
1
+package MyModel5::dbix_custom::table3;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'MyModel5';
7
+
8
+__PACKAGE__->attr(name => 'dbix_custom.table3');
9
+__PACKAGE__->attr(table => 'dbix_custom.table3');
10
+
11
+__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
12
+
13
+1;
+14
t/common_fullqualified/MyModel6/dbix_custom/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel6::dbix_custom::table1;
2
+
3
+use base 'MyModel6';
4
+
5
+__PACKAGE__->attr(
6
+    join => sub {
7
+      [
8
+        'left outer join dbix_custom.table2 on dbix_custom.table1.key1 = dbix_custom.table2.key1'
9
+      ]
10
+    },
11
+    primary_key => sub { ['key1'] }
12
+);
13
+
14
+1;
+5
t/common_fullqualified/MyModel6/dbix_custom/table2.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel6::dbix_custom::table2;
2
+
3
+use base 'MyModel6';
4
+
5
+1;
+11
t/common_fullqualified/MyModel6/dbix_custom/table3.pm
... ...
@@ -0,0 +1,11 @@
1
+package MyModel6::dbix_custom::table3;
2
+
3
+use base 'MyModel6';
4
+
5
+__PACKAGE__->attr(filter => sub {
6
+  [
7
+    key1 => {in => sub { uc $_[0] }}
8
+  ]
9
+});
10
+
11
+1;
+14
t/common_fullqualified/MyModel7/dbix_custom/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel7::dbix_custom::table1;
2
+
3
+use base 'MyModel7';
4
+
5
+__PACKAGE__->attr(
6
+  primary_key => sub { ['key1'] },
7
+  join => sub {
8
+    [
9
+      'left outer join dbix_custom.table2 on dbix_custom.table1.key1 = dbix_custom.table2.key1'
10
+    ]
11
+  },
12
+);
13
+
14
+1;
+5
t/common_fullqualified/MyModel7/dbix_custom/table2.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel7::dbix_custom::table2;
2
+
3
+use base 'MyModel7';
4
+
5
+1;
+14
t/common_fullqualified/MyModel8/dbix_custom/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel8::dbix_custom::table1;
2
+use MyModel8 -base;
3
+
4
+has join => sub {
5
+  my $self = shift;
6
+  
7
+  my $alias = 'dbix_custom.table2_alias';
8
+  $alias =~ s/\./_/g;
9
+  
10
+  return ["left join dbix_custom.table2 $alias on dbix_custom.table1.key1 = $alias.key1"];
11
+};
12
+
13
+
14
+1;
+10
t/common_fullqualified/MyModel8/dbix_custom/table2.pm
... ...
@@ -0,0 +1,10 @@
1
+package MyModel8::dbix_custom::table2;
2
+use MyModel8 -base;
3
+
4
+has filter => sub {
5
+  {
6
+    key3 => {out => sub { $_[0] * 2}, in => sub { $_[0] * 3}, end => sub { $_[0] * 4 }}
7
+  }
8
+};
9
+
10
+1;
+6 -5
t/common_fullqualified/MyModel8/main/table1.pm
... ...
@@ -2,11 +2,12 @@ package MyModel8::main::table1;
2 2
 use MyModel8 -base;
3 3
 
4 4
 has join => sub {
5
-   my $self = shift;
6
-   
7
-   my ($q, $p) = $self->_qp;
8
-   
9
-   return ["left join main.table2 main_table2_alias on main.table1.key1 = main_table2_alias.key1"]
5
+  my $self = shift;
6
+  
7
+  my $alias = 'main.table2_alias';
8
+  $alias =~ s/\./_/g;
9
+  
10
+  return ["left join main.table2 $alias on main.table1.key1 = $alias.key1"];
10 11
 };
11 12
 
12 13
 
+6 -6
t/common_uc/MyModel6/TABLE1.pm
... ...
@@ -3,12 +3,12 @@ package MyModel6::TABLE1;
3 3
 use base 'MyModel6';
4 4
 
5 5
 __PACKAGE__->attr(
6
-  join => sub {
7
-    [
8
-      'left outer join TABLE2 on TABLE1.KEY1 = TABLE2.KEY1'
9
-    ]
10
-  },
11
-  primary_key => sub { ['KEY1'] }
6
+    join => sub {
7
+      [
8
+        'left outer join TABLE2 on TABLE1.KEY1 = TABLE2.KEY1'
9
+      ]
10
+    },
11
+    primary_key => sub { ['KEY1'] }
12 12
 );
13 13
 
14 14
 1;
+8 -1
t/common_uc/MyModel8/TABLE1.pm
... ...
@@ -1,7 +1,14 @@
1 1
 package MyModel8::TABLE1;
2 2
 use MyModel8 -base;
3 3
 
4
-has join => sub { ['left join TABLE2 TABLE2_ALIAS on TABLE1.KEY1 = TABLE2_ALIAS.KEY1'] };
4
+has join => sub {
5
+  my $self = shift;
6
+  
7
+  my $alias = 'TABLE2_ALIAS';
8
+  $alias =~ s/\./_/g;
9
+  
10
+  return ["left join TABLE2 $alias on TABLE1.KEY1 = $alias.KEY1"];
11
+};
5 12
 
6 13
 
7 14
 1;
+20 -17
t/create_fullqualified_module.pl
... ...
@@ -27,23 +27,26 @@ for my $dir (@dirs) {
27 27
     my @files = grep { /table\d\.pm/ } glob("$dir/*");
28 28
     for my $file (@files) {
29 29
     
30
-      my $content = do {
31
-        open my $fh, '<', $file;
32
-        local $/;
33
-        <$fh>;
34
-      };
30
+      for my $database (qw/main dbix_custom/) {
35 31
 
36
-      $content =~ s/::table(\d)/::main::table$1/g;
37
-      $content =~ s/([^:])table(\d)/$1main.table$2/g;
38
-      
39
-      mkpath "$common_fullqualified/$base_dir/main";
40
-      my $base_name = (fileparse($file, qr/\..+$/))[0];
41
-      $base_name = $base_name;
42
-      my $new_file = "$common_fullqualified/$base_dir/main/$base_name.pm";
43
-      
44
-      open my $fh, '>', $new_file
45
-        or die "Can't write file: $!";
46
-      
47
-      print $fh $content;
32
+        my $content = do {
33
+          open my $fh, '<', $file;
34
+          local $/;
35
+          <$fh>;
36
+        };
37
+        
38
+        $content =~ s/::table(\d)/::${database}::table$1/g;
39
+        $content =~ s/([^:])table(\d)/$1$database.table$2/g;
40
+        
41
+        mkpath "$common_fullqualified/$base_dir/$database";
42
+        my $base_name = (fileparse($file, qr/\..+$/))[0];
43
+        $base_name = $base_name;
44
+        my $new_file = "$common_fullqualified/$base_dir/$database/$base_name.pm";
45
+        
46
+        open my $fh, '>', $new_file
47
+          or die "Can't write file: $!";
48
+        
49
+        print $fh $content;
50
+      }
48 51
     }
49 52
 }