Showing 5 changed files with 166 additions and 77 deletions
+3
Changes
... ...
@@ -1,3 +1,6 @@
1
+0.1665
2
+    - removed EXPERIMETNAL flag from insert_at(), update_at(), delete_at(), select_at(), insert_param(), not_exists(), select()'s query option, update_param(), where, table tag, each column, safety_character, DBIx::Where, where().
3
+    - added EXPERIMETNAL create_model()
1 4
 0.1664
2 5
     - where can recieve array refrence, which contains where cluase and paramter.
3 6
 0.1663
+117 -76
lib/DBIx/Custom.pm
... ...
@@ -1,6 +1,6 @@
1 1
 package DBIx::Custom;
2 2
 
3
-our $VERSION = '0.1664';
3
+our $VERSION = '0.1665';
4 4
 
5 5
 use 5.008001;
6 6
 use strict;
... ...
@@ -339,6 +339,60 @@ sub DESTROY { }
339 339
 
340 340
 our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';
341 341
 
342
+sub create_model {
343
+    my $self = shift;
344
+    
345
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
346
+    $args->{dbi} = $self;
347
+    
348
+    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
349
+    my $model_name  = delete $args->{name};
350
+    my $model_table = delete $args->{table};
351
+    $model_name ||= $model_table;
352
+    
353
+    my $model = $model_class->new($args);
354
+    $model->name($model_name) unless $model->name;
355
+    $model->table($model_table) unless $model->table;
356
+    
357
+    # Apply filter
358
+    croak "$model_class filter must be array reference"
359
+      unless ref $model->filter eq 'ARRAY';
360
+    $self->apply_filter($model->table, @{$model->filter});
361
+    
362
+    # Table - Model
363
+    croak "Table name is duplicated"
364
+      if exists $self->{_model_from}->{$model->table};
365
+    $self->{_model_from}->{$model->table} = $model->name;
366
+
367
+    # Table alias
368
+    $self->{_table_alias} ||= {};
369
+    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
370
+    
371
+    # Set model
372
+    $self->model($model->name, $model);
373
+    
374
+    return $self;
375
+}
376
+
377
+sub each_column {
378
+    my ($self, $cb) = @_;
379
+    
380
+    # Iterate all tables
381
+    my $sth_tables = $self->dbh->table_info;
382
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
383
+        
384
+        # Table
385
+        my $table = $table_info->{TABLE_NAME};
386
+        
387
+        # Iterate all columns
388
+        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
389
+        while (my $column_info = $sth_columns->fetchrow_hashref) {
390
+            my $column = $column_info->{COLUMN_NAME};
391
+            $self->$cb($table, $column, $column_info);
392
+        }
393
+    }
394
+}
395
+
342 396
 sub execute{
343 397
     my ($self, $query, %args)  = @_;
344 398
     
... ...
@@ -587,25 +641,6 @@ sub insert_param {
587 641
     return join ' ', @tag;
588 642
 }
589 643
 
590
-sub each_column {
591
-    my ($self, $cb) = @_;
592
-    
593
-    # Iterate all tables
594
-    my $sth_tables = $self->dbh->table_info;
595
-    while (my $table_info = $sth_tables->fetchrow_hashref) {
596
-        
597
-        # Table
598
-        my $table = $table_info->{TABLE_NAME};
599
-        
600
-        # Iterate all columns
601
-        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
602
-        while (my $column_info = $sth_columns->fetchrow_hashref) {
603
-            my $column = $column_info->{COLUMN_NAME};
604
-            $self->$cb($table, $column, $column_info);
605
-        }
606
-    }
607
-}
608
-
609 644
 sub include_model {
610 645
     my ($self, $name_space, $model_infos) = @_;
611 646
     
... ...
@@ -631,7 +666,6 @@ sub include_model {
631 666
         close $dh;
632 667
     }
633 668
     
634
-    my $table_alias = {};
635 669
     foreach my $model_info (@$model_infos) {
636 670
         
637 671
         # Model class, name, table
... ...
@@ -646,7 +680,7 @@ sub include_model {
646 680
             $model_name  ||= $model_class;
647 681
             $model_table ||= $model_name;
648 682
         }
649
-        else { $model_class =$model_name = $model_table = $model_info }
683
+        else { $model_class = $model_name = $model_table = $model_info }
650 684
         my $mclass = "${name_space}::$model_class";
651 685
         
652 686
         # Load
... ...
@@ -658,29 +692,15 @@ sub include_model {
658 692
         }
659 693
         
660 694
         # Instantiate
661
-        my $model = $mclass->new(dbi => $self);
662
-        $model->name($model_name) unless $model->name;
663
-        $model->table($model_table) unless $model->table;
664
-        
665
-        # Set
666
-        $self->model($model->name, $model);
667
-        
668
-        # Apply filter
669
-        croak "${name_space}::$model_class filter must be array reference"
670
-          unless ref $model->filter eq 'ARRAY';
671
-        $self->apply_filter($model->table, @{$model->filter});
695
+        my $args = {};
696
+        $args->{model_class} = $mclass if $mclass;
697
+        $args->{name}        = $model_name if $model_name;
698
+        $args->{table}       = $model_table if $model_table;
672 699
         
673
-        # Table alias
674
-        $table_alias = {%$table_alias, %{$model->table_alias}};
675
-        
676
-        # Table - Model
677
-        croak "Table name is duplicated"
678
-          if exists $self->{_model_from}->{$model->table};
679
-        $self->{_model_from}->{$model->table} = $model->name;
700
+        # Create model
701
+        $self->create_model($args);
680 702
     }
681 703
     
682
-    $self->{_table_alias} = $table_alias;
683
-    
684 704
     return $self;
685 705
 }
686 706
 
... ...
@@ -1605,7 +1625,7 @@ Query builder, default to L<DBIx::Custom::QueryBuilder> object.
1605 1625
 
1606 1626
 Result class, default to L<DBIx::Custom::Result>.
1607 1627
 
1608
-=head2 C<safety_character> EXPERIMENTAL
1628
+=head2 C<safety_character>
1609 1629
 
1610 1630
     my $safety_character = $self->safety_character;
1611 1631
     $dbi                 = $self->safety_character($character);
... ...
@@ -1704,6 +1724,28 @@ L<DBIx::Custom> is a wrapper of L<DBI>.
1704 1724
 C<AutoCommit> and C<RaiseError> options are true, 
1705 1725
 and C<PrintError> option is false by default.
1706 1726
 
1727
+=head2 create_model
1728
+
1729
+    $dbi->create_model(
1730
+        table => 'book',
1731
+        primary_key => 'id',
1732
+        join => [
1733
+            'inner join company on book.comparny_id = company.id'
1734
+        ],
1735
+        filter => [
1736
+            publish_date => {
1737
+                out => 'tp_to_date',
1738
+                in => 'date_to_tp',
1739
+                end => 'tp_to_displaydate'
1740
+            }
1741
+        ]
1742
+    );
1743
+
1744
+Create L<DBIx::Custom::Model> object and initialize model.
1745
+the module is used from model() method.
1746
+
1747
+   $dbi->model('book')->select(...);
1748
+
1707 1749
 =head2 C<create_query>
1708 1750
     
1709 1751
     my $query = $dbi->create_query(
... ...
@@ -1726,7 +1768,25 @@ instead of other methods, such as C<insert>, C<update>.
1726 1768
 Get and set database handle of L<DBI>.
1727 1769
 
1728 1770
 If process is spawn by forking, new connection is created automatically.
1729
-This feature is EXPERIMETNAL.
1771
+
1772
+=head2 C<each_column>
1773
+
1774
+    $dbi->each_column(
1775
+        sub {
1776
+            my ($dbi, $table, $column, $column_info) = @_;
1777
+            
1778
+            my $type = $column_info->{TYPE_NAME};
1779
+            
1780
+            if ($type eq 'DATE') {
1781
+                # ...
1782
+            }
1783
+        }
1784
+    );
1785
+
1786
+Iterate all column informations of all table from database.
1787
+Argument is callback when one column is found.
1788
+Callback receive four arguments, dbi object, table name,
1789
+column name and column information.
1730 1790
 
1731 1791
 =head2 C<execute>
1732 1792
 
... ...
@@ -1871,7 +1931,7 @@ Create column clause. The follwoing column clause is created.
1871 1931
     book.author as book__author,
1872 1932
     book.title as book__title
1873 1933
 
1874
-=item C<query> EXPERIMENTAL
1934
+=item C<query>
1875 1935
 
1876 1936
 Get L<DBIx::Custom::Query> object instead of executing SQL.
1877 1937
 This is true or false value.
... ...
@@ -1891,7 +1951,7 @@ You can check SQL.
1891 1951
 Delete statement to delete all rows.
1892 1952
 Options is same as C<delete()>.
1893 1953
 
1894
-=head2 C<delete_at()> EXPERIMENTAL
1954
+=head2 C<delete_at()>
1895 1955
 
1896 1956
 Delete statement, using primary key.
1897 1957
 
... ...
@@ -2000,7 +2060,7 @@ filter name registerd by C<register_filter()>.
2000 2060
 
2001 2061
 These filters are added to the C<out> filters, set by C<apply_filter()>.
2002 2062
 
2003
-=item C<query> EXPERIMENTAL
2063
+=item C<query>
2004 2064
 
2005 2065
 Get L<DBIx::Custom::Query> object instead of executing SQL.
2006 2066
 This is true or false value.
... ...
@@ -2013,7 +2073,7 @@ You can check SQL.
2013 2073
 
2014 2074
 =back
2015 2075
 
2016
-=head2 C<insert_at()> EXPERIMENTAL
2076
+=head2 C<insert_at()>
2017 2077
 
2018 2078
 Insert statement, using primary key.
2019 2079
 
... ...
@@ -2061,7 +2121,7 @@ Place holders are set to 5 and 'Perl'.
2061 2121
 
2062 2122
 =back
2063 2123
 
2064
-=head2 C<insert_param> EXPERIMENTAL
2124
+=head2 C<insert_param>
2065 2125
 
2066 2126
     my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2067 2127
 
... ...
@@ -2069,25 +2129,6 @@ Create insert parameter tag.
2069 2129
 
2070 2130
     {insert_param title age}
2071 2131
 
2072
-=head2 C<each_column> EXPERIMENTAL
2073
-
2074
-    $dbi->each_column(
2075
-        sub {
2076
-            my ($dbi, $table, $column, $column_info) = @_;
2077
-            
2078
-            my $type = $column_info->{TYPE_NAME};
2079
-            
2080
-            if ($type eq 'DATE') {
2081
-                # ...
2082
-            }
2083
-        }
2084
-    );
2085
-
2086
-Iterate all column informations of all table from database.
2087
-Argument is callback when one column is found.
2088
-Callback receive four arguments, dbi object, table name,
2089
-column name and column information.
2090
-
2091 2132
 =head2 C<include_model> EXPERIMENTAL
2092 2133
 
2093 2134
     $dbi->include_model('MyModel');
... ...
@@ -2187,7 +2228,7 @@ Create column clause for myself. The follwoing column clause is created.
2187 2228
 
2188 2229
 Create a new L<DBIx::Custom> object.
2189 2230
 
2190
-=head2 C<not_exists> EXPERIMENTAL
2231
+=head2 C<not_exists>
2191 2232
 
2192 2233
     my $not_exists = $dbi->not_exists;
2193 2234
 
... ...
@@ -2414,7 +2455,7 @@ filter name registerd by C<register_filter()>.
2414 2455
 
2415 2456
 These filters are added to the C<out> filters, set by C<apply_filter()>.
2416 2457
 
2417
-=item C<query> EXPERIMENTAL
2458
+=item C<query>
2418 2459
 
2419 2460
 Get L<DBIx::Custom::Query> object instead of executing SQL.
2420 2461
 This is true or false value.
... ...
@@ -2438,7 +2479,7 @@ This is used to bind paramter by C<bind_param()> of statment handle.
2438 2479
 
2439 2480
 =back
2440 2481
 
2441
-=head2 C<select_at()> EXPERIMENTAL
2482
+=head2 C<select_at()>
2442 2483
 
2443 2484
 Select statement, using primary key.
2444 2485
 
... ...
@@ -2571,7 +2612,7 @@ filter name registerd by C<register_filter()>.
2571 2612
 
2572 2613
 These filters are added to the C<out> filters, set by C<apply_filter()>.
2573 2614
 
2574
-=item C<query> EXPERIMENTAL
2615
+=item C<query>
2575 2616
 
2576 2617
 Get L<DBIx::Custom::Query> object instead of executing SQL.
2577 2618
 This is true or false value.
... ...
@@ -2591,7 +2632,7 @@ You can check SQL.
2591 2632
 Update statement to update all rows.
2592 2633
 Options is same as C<update()>.
2593 2634
 
2594
-=head2 C<update_at()> EXPERIMENTAL
2635
+=head2 C<update_at()>
2595 2636
 
2596 2637
 Update statement, using primary key.
2597 2638
 
... ...
@@ -2639,7 +2680,7 @@ Place holders are set to 'Perl' and 5.
2639 2680
 
2640 2681
 =back
2641 2682
 
2642
-=head2 C<update_param> EXPERIMENTAL
2683
+=head2 C<update_param>
2643 2684
 
2644 2685
     my $update_param = $dbi->update_param({title => 'a', age => 2});
2645 2686
 
... ...
@@ -2647,7 +2688,7 @@ Create update parameter tag.
2647 2688
 
2648 2689
     {update_param title age}
2649 2690
 
2650
-=head2 C<where> EXPERIMENTAL
2691
+=head2 C<where>
2651 2692
 
2652 2693
     my $where = $dbi->where(
2653 2694
         clause => ['and', '{= title}', '{= author}'],
... ...
@@ -2667,7 +2708,7 @@ C<columns> of model object is automatically set, parsing database information.
2667 2708
 
2668 2709
 The following tags is available.
2669 2710
 
2670
-=head2 C<table> EXPERIMENTAL
2711
+=head2 C<table>
2671 2712
 
2672 2713
 Table tag
2673 2714
 
+13
lib/DBIx/Custom/Model.pm
... ...
@@ -89,6 +89,19 @@ sub mycolumn {
89 89
     return $self->dbi->mycolumn($table, $columns);
90 90
 }
91 91
 
92
+sub new {
93
+    my $self = shift->SUPER::new(@_);
94
+    
95
+    # Check attribute names
96
+    my @attrs = keys %$self;
97
+    foreach my $attr (@attrs) {
98
+        croak qq{"$attr" is invalid attribute name}
99
+          unless $self->can($attr);
100
+    }
101
+    
102
+    return $self;
103
+}
104
+
92 105
 1;
93 106
 
94 107
 =head1 NAME
+1 -1
lib/DBIx/Custom/Where.pm
... ...
@@ -112,7 +112,7 @@ sub _parse {
112 112
 
113 113
 =head1 NAME
114 114
 
115
-DBIx::Custom::Where - Where clause EXPERIMENTAL
115
+DBIx::Custom::Where - Where clause
116 116
 
117 117
 =head1 SYNOPSYS
118 118
 
+32
t/dbix-custom-core-sqlite.t
... ...
@@ -1940,3 +1940,35 @@ $result = $dbi->execute('select length(key1) as key1_length from table1');
1940 1940
 $row = $result->fetch_hash_first;
1941 1941
 is($row->{key1_length}, length $binary);
1942 1942
 
1943
+test 'create_model';
1944
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
1945
+$dbi->execute($CREATE_TABLE->{0});
1946
+$dbi->execute($CREATE_TABLE->{2});
1947
+
1948
+$dbi->create_model(
1949
+    table => 'table1',
1950
+    join => [
1951
+       'left outer join table2 on table1.key1 = table2.key1'
1952
+    ],
1953
+    primary_key => ['key1']
1954
+);
1955
+$dbi->create_model(
1956
+    table => 'table2'
1957
+);
1958
+$dbi->create_model(
1959
+    table => 'table3',
1960
+    filter => [
1961
+        key1 => {in => sub { uc $_[0] }}
1962
+    ]
1963
+);
1964
+$dbi->setup_model;
1965
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1966
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
1967
+$model = $dbi->model('table1');
1968
+$result = $model->select(
1969
+    column => [$model->mycolumn, $model->column('table2')],
1970
+    where => {'table1.key1' => 1}
1971
+);
1972
+is_deeply($result->fetch_hash_first,
1973
+          {key1 => 1, key2 => 2, 'table2__key1' => 1, 'table2__key3' => 3});
1974
+