Showing 11 changed files with 155 additions and 175 deletions
+1 -1
Changes
... ...
@@ -1,5 +1,5 @@
1 1
 0.25
2
-  - added DBIX_CUSTOM_SUPPRESS_DEPRECTION environment varaible
2
+  - added DBIX_CUSTOM_SUPPRESS_DEPRECATION environment varaible
3 3
     to suppress deprecation warnings
4 4
   - removed EXPERIMENTAL status from DBIx::Custom::Result::kv method
5 5
   - removed EXPERIMETNAL status from DBIx::Custom::Result::flat method
+71 -60
lib/DBIx/Custom.pm
... ...
@@ -2,7 +2,7 @@ use 5.008007;
2 2
 package DBIx::Custom;
3 3
 use Object::Simple -base;
4 4
 
5
-our $VERSION = '0.24';
5
+our $VERSION = '0.25';
6 6
 
7 7
 use Carp 'croak';
8 8
 use DBI;
... ...
@@ -13,7 +13,7 @@ use DBIx::Custom::Where;
13 13
 use DBIx::Custom::Model;
14 14
 use DBIx::Custom::Tag;
15 15
 use DBIx::Custom::Order;
16
-use DBIx::Custom::Util qw/_array_to_hash _subname/;
16
+use DBIx::Custom::Util qw/_array_to_hash _subname _deprecate/;
17 17
 use DBIx::Custom::Mapper;
18 18
 use DBIx::Custom::NotExists;
19 19
 use Encode qw/encode encode_utf8 decode_utf8/;
... ...
@@ -230,7 +230,7 @@ sub dbh {
230 230
 
231 231
 sub delete {
232 232
   my ($self, %opt) = @_;
233
-  warn "delete method where_param option is DEPRECATED!"
233
+  _deprecate('0.24', "delete method where_param option is DEPRECATED!")
234 234
     if $opt{where_param};
235 235
   
236 236
   # Don't allow delete all rows
... ...
@@ -278,7 +278,7 @@ sub create_model {
278 278
       ? [%{$model->filter}]
279 279
       : $model->filter;
280 280
     $filter ||= [];
281
-    warn "DBIx::Custom::Model filter method is DEPRECATED!"
281
+    _deprecate('0.24', "DBIx::Custom::Model filter method is DEPRECATED!")
282 282
       if @$filter;
283 283
     $self->_apply_filter($model->table, @$filter);
284 284
   }
... ...
@@ -375,7 +375,7 @@ sub execute {
375 375
   }
376 376
   
377 377
   # Options
378
-  warn "sqlfilter option is DEPRECATED" if $opt{sqlfilter};
378
+  _deprecate('0.24', "sqlfilter option is DEPRECATED") if $opt{sqlfilter};
379 379
   $params ||= $opt{param} || {};
380 380
   my $tables = $opt{table} || [];
381 381
   $tables = [$tables] unless ref $tables eq 'ARRAY';
... ...
@@ -414,8 +414,9 @@ sub execute {
414 414
   my $query;
415 415
   if (ref $sql) {
416 416
     $query = $sql;
417
-    warn "execute method receiving query object as first parameter is DEPRECATED!" .
418
-      "because this is very buggy.";
417
+    _deprecate('0.24', "execute method receiving query " .
418
+      "object as first parameter is DEPRECATED!" .
419
+      "because this is very buggy.");
419 420
   }
420 421
   else {
421 422
     $query = $opt{reuse}->{$sql} if $opt{reuse};
... ...
@@ -456,7 +457,8 @@ sub execute {
456 457
   # Merge id to parameter
457 458
   if (defined $opt{id}) {
458 459
     my $statement = $query->{statement};
459
-    warn "execute method id option is DEPRECATED!" unless $statement;
460
+    _deprecate('0.24', "execute method id option is DEPRECATED!")
461
+      unless $statement;
460 462
     croak "execute id option must be specified with primary_key option"
461 463
       unless $opt{primary_key};
462 464
     $opt{primary_key} = [$opt{primary_key}] unless ref $opt{primary_key};
... ...
@@ -683,7 +685,8 @@ sub insert {
683 685
   # Options
684 686
   my $params = @_ % 2 ? shift : undef;
685 687
   my %opt = @_;
686
-  warn "insert method param option is DEPRECATED!" if $opt{param};
688
+  _deprecate('0.24', "insert method param option is DEPRECATED!")
689
+    if $opt{param};
687 690
   $params ||= delete $opt{param} || {};
688 691
   
689 692
   my $multi;
... ...
@@ -692,7 +695,7 @@ sub insert {
692 695
   
693 696
   # Timestamp(DEPRECATED!)
694 697
   if (!$multi && $opt{timestamp} && (my $insert_timestamp = $self->insert_timestamp)) {
695
-    warn "insert timestamp option is DEPRECATED! use ctime option";
698
+    _deprecate('0.24', "insert timestamp option is DEPRECATED! use ctime option");
696 699
     my $columns = $insert_timestamp->[0];
697 700
     $columns = [$columns] unless ref $columns eq 'ARRAY';
698 701
     my $value = $insert_timestamp->[1];
... ...
@@ -702,11 +705,11 @@ sub insert {
702 705
 
703 706
   # Created time and updated time
704 707
   my @timestamp_cleanup;
705
-  warn "insert method created_at option is DEPRECATED! "
706
-      . "use ctime option instead. " . _subname
708
+  _deprecate('0.24', "insert method created_at option is DEPRECATED! " .
709
+      "use ctime option instead. ")
707 710
     if $opt{created_at};
708
-  warn "insert method updated_at option is DEPRECATED! "
709
-      . "use mtime option instead. " . _subname
711
+  _deprecate('0.24', "insert method updated_at option is DEPRECATED! " .
712
+      "use mtime option instead. ")
710 713
     if $opt{updated_at};
711 714
   $opt{ctime} ||= $opt{created_at};
712 715
   $opt{mtime} ||= $opt{updated_at};
... ...
@@ -768,7 +771,7 @@ sub insert {
768 771
 sub insert_timestamp {
769 772
   my $self = shift;
770 773
   
771
-  warn "insert_timestamp method is DEPRECATED! use now attribute";
774
+  _deprecate('0.24', "insert_timestamp method is DEPRECATED! use now attribute");
772 775
   
773 776
   if (@_) {
774 777
     $self->{insert_timestamp} = [@_];
... ...
@@ -1037,12 +1040,12 @@ sub select {
1037 1040
   $opt{table} = $tables;
1038 1041
   $table_is_empty = 1 unless @$tables;
1039 1042
   my $where_param = $opt{where_param} || delete $opt{param} || {};
1040
-  warn "select method where_param option is DEPRECATED!"
1043
+  _deprecate('0.24', "select method where_param option is DEPRECATED!")
1041 1044
     if $opt{where_param};
1042 1045
   
1043 1046
   # Add relation tables(DEPRECATED!);
1044 1047
   if ($opt{relation}) {
1045
-    warn "select() relation option is DEPRECATED!";
1048
+    _deprecate('0.24', "select() relation option is DEPRECATED!");
1046 1049
     $self->_add_relation_table($tables, $opt{relation});
1047 1050
   }
1048 1051
   
... ...
@@ -1061,10 +1064,10 @@ sub select {
1061 1064
         $column = $self->column(%$column) if ref $column eq 'HASH';
1062 1065
       }
1063 1066
       elsif (ref $column eq 'ARRAY') {
1064
-        warn "select column option [COLUMN => ALIAS] syntax is DEPRECATED!" .
1065
-          "use q method to quote the value";
1067
+        _deprecate('0.24', "select column option [COLUMN => ALIAS] syntax " .
1068
+          "is DEPRECATED! use q method to quote the value");
1066 1069
         if (@$column == 3 && $column->[1] eq 'as') {
1067
-          warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
1070
+          _deprecate('0.24', "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]");
1068 1071
           splice @$column, 1, 1;
1069 1072
         }
1070 1073
         
... ...
@@ -1262,8 +1265,8 @@ sub update {
1262 1265
   # Options
1263 1266
   my $param = @_ % 2 ? shift : undef;
1264 1267
   my %opt = @_;
1265
-  warn "update param option is DEPRECATED!" if $opt{param};
1266
-  warn "update method where_param option is DEPRECATED!"
1268
+  _deprecate('0.24', "update param option is DEPRECATED!") if $opt{param};
1269
+  _deprecate('0.24', "update method where_param option is DEPRECATED!")
1267 1270
     if $opt{where_param};
1268 1271
   $param ||= $opt{param} || {};
1269 1272
   
... ...
@@ -1273,7 +1276,7 @@ sub update {
1273 1276
   
1274 1277
   # Timestamp(DEPRECATED!)
1275 1278
   if ($opt{timestamp} && (my $update_timestamp = $self->update_timestamp)) {
1276
-    warn "update timestamp option is DEPRECATED! use mtime";
1279
+    _deprecate('0.24', "update timestamp option is DEPRECATED! use mtime");
1277 1280
     my $columns = $update_timestamp->[0];
1278 1281
     $columns = [$columns] unless ref $columns eq 'ARRAY';
1279 1282
     my $value = $update_timestamp->[1];
... ...
@@ -1283,8 +1286,8 @@ sub update {
1283 1286
 
1284 1287
   # Created time and updated time
1285 1288
   my @timestamp_cleanup;
1286
-  warn "update method update_at option is DEPRECATED! "
1287
-      . "use mtime option instead " . _subname
1289
+  _deprecate('0.24', "update method update_at option is DEPRECATED! " .
1290
+      "use mtime option instead.")
1288 1291
     if $opt{updated_at};
1289 1292
   $opt{mtime} ||= $opt{updated_at};
1290 1293
   if (defined $opt{mtime}) {
... ...
@@ -1334,7 +1337,7 @@ sub update_or_insert {
1334 1337
 sub update_timestamp {
1335 1338
   my $self = shift;
1336 1339
   
1337
-  warn "update_timestamp method is DEPRECATED! use now method";
1340
+  _deprecate('0.24', "update_timestamp method is DEPRECATED! use now method");
1338 1341
   
1339 1342
   if (@_) {
1340 1343
     $self->{update_timestamp} = [@_];
... ...
@@ -1575,7 +1578,7 @@ sub _connect {
1575 1578
   
1576 1579
   # Attributes
1577 1580
   my $dsn = $self->data_source;
1578
-  warn "data_source is DEPRECATED!\n"
1581
+  _deprecate('0.24', "data_source is DEPRECATED!\n")
1579 1582
     if $dsn;
1580 1583
   $dsn ||= $self->dsn;
1581 1584
   croak qq{"dsn" must be specified } . _subname
... ...
@@ -1631,9 +1634,9 @@ sub _need_tables {
1631 1634
 sub _option {
1632 1635
   my $self = shift;
1633 1636
   my $option = {%{$self->dbi_options}, %{$self->dbi_option}, %{$self->option}};
1634
-  warn "dbi_options is DEPRECATED! use option instead\n"
1637
+  _deprecate('0.24', "dbi_options is DEPRECATED! use option instead\n")
1635 1638
     if keys %{$self->dbi_options};
1636
-  warn "dbi_option is DEPRECATED! use option instead\n"
1639
+  _deprecate('0.24', "dbi_option is DEPRECATED! use option instead\n")
1637 1640
     if keys %{$self->dbi_option};
1638 1641
   return $option;
1639 1642
 }
... ...
@@ -1887,15 +1890,15 @@ has filter_check  => 1;
1887 1890
 has 'reserved_word_quote';
1888 1891
 has dbi_option => sub { {} };
1889 1892
 has default_dbi_option => sub {
1890
-  warn "default_dbi_option is DEPRECATED! use default_option instead";
1893
+  _deprecate('0.24', "default_dbi_option is DEPRECATED! use default_option instead");
1891 1894
   return shift->default_option;
1892 1895
 };
1893 1896
 
1894 1897
 # DEPRECATED
1895 1898
 sub tag_parse {
1896 1899
  my $self = shift;
1897
- warn "tag_parse is DEPRECATED! use \$ENV{DBIX_CUSTOM_TAG_PARSE} " .
1898
-   "environment variable";
1900
+ _deprecate('0.24', "tag_parse is DEPRECATED! use \$ENV{DBIX_CUSTOM_TAG_PARSE} " .
1901
+   "environment variable");
1899 1902
   if (@_) {
1900 1903
     $self->{tag_parse} = $_[0];
1901 1904
     return $self;
... ...
@@ -1905,14 +1908,14 @@ sub tag_parse {
1905 1908
 
1906 1909
 # DEPRECATED!
1907 1910
 sub method {
1908
-  warn "method is DEPRECATED! use helper instead";
1911
+  _deprecate('0.24', "method is DEPRECATED! use helper instead");
1909 1912
   return shift->helper(@_);
1910 1913
 }
1911 1914
 
1912 1915
 # DEPRECATED!
1913 1916
 sub assign_param {
1914 1917
   my $self = shift;
1915
-  warn "assing_param is DEPRECATED! use assign_clause instead";
1918
+  _deprecate('0.24', "assing_param is DEPRECATED! use assign_clause instead");
1916 1919
   return $self->assign_clause(@_);
1917 1920
 }
1918 1921
 
... ...
@@ -1920,7 +1923,7 @@ sub assign_param {
1920 1923
 sub update_param {
1921 1924
   my ($self, $param, $opts) = @_;
1922 1925
   
1923
-  warn "update_param is DEPRECATED! use assign_clause instead.";
1926
+  _deprecate('0.24', "update_param is DEPRECATED! use assign_clause instead.");
1924 1927
   
1925 1928
   # Create update parameter tag
1926 1929
   my $tag = $self->assign_clause($param, $opts);
... ...
@@ -1931,7 +1934,7 @@ sub update_param {
1931 1934
 
1932 1935
 # DEPRECATED!
1933 1936
 sub create_query {
1934
-  warn "create_query is DEPRECATED! use query option of each method";
1937
+  _deprecate('0.24', "create_query is DEPRECATED! use query option of each method");
1935 1938
   shift->_create_query(@_);
1936 1939
 }
1937 1940
 
... ...
@@ -1939,7 +1942,7 @@ sub create_query {
1939 1942
 sub apply_filter {
1940 1943
   my $self = shift;
1941 1944
   
1942
-  warn "apply_filter is DEPRECATED!";
1945
+  _deprecate('0.24', "apply_filter is DEPRECATED!");
1943 1946
   return $self->_apply_filter(@_);
1944 1947
 }
1945 1948
 
... ...
@@ -1947,7 +1950,7 @@ sub apply_filter {
1947 1950
 sub select_at {
1948 1951
   my ($self, %opt) = @_;
1949 1952
 
1950
-  warn "select_at is DEPRECATED! use select method id option instead";
1953
+  _deprecate('0.24', "select_at is DEPRECATED! use select method id option instead");
1951 1954
 
1952 1955
   # Options
1953 1956
   my $primary_keys = delete $opt{primary_key};
... ...
@@ -1969,7 +1972,7 @@ sub select_at {
1969 1972
 sub delete_at {
1970 1973
   my ($self, %opt) = @_;
1971 1974
 
1972
-  warn "delete_at is DEPRECATED! use delete method id option instead";
1975
+  _deprecate('0.24', "delete_at is DEPRECATED! use delete method id option instead");
1973 1976
   
1974 1977
   # Options
1975 1978
   my $primary_keys = delete $opt{primary_key};
... ...
@@ -1985,7 +1988,7 @@ sub delete_at {
1985 1988
 sub update_at {
1986 1989
   my $self = shift;
1987 1990
 
1988
-  warn "update_at is DEPRECATED! use update method id option instead";
1991
+  _deprecate('0.24', "update_at is DEPRECATED! use update method id option instead");
1989 1992
   
1990 1993
   # Options
1991 1994
   my $param;
... ...
@@ -2006,7 +2009,7 @@ sub update_at {
2006 2009
 sub insert_at {
2007 2010
   my $self = shift;
2008 2011
   
2009
-  warn "insert_at is DEPRECATED! use insert method id option instead";
2012
+  _deprecate('0.24', "insert_at is DEPRECATED! use insert method id option instead");
2010 2013
   
2011 2014
   # Options
2012 2015
   my $param;
... ...
@@ -2029,7 +2032,7 @@ sub insert_at {
2029 2032
 sub register_tag {
2030 2033
   my $self = shift;
2031 2034
   
2032
-  warn "register_tag is DEPRECATED!";
2035
+  _deprecate('0.24', "register_tag is DEPRECATED!");
2033 2036
   
2034 2037
   # Merge tag
2035 2038
   my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
... ...
@@ -2041,7 +2044,7 @@ sub register_tag {
2041 2044
 # DEPRECATED!
2042 2045
 sub register_tag_processor {
2043 2046
   my $self = shift;
2044
-  warn "register_tag_processor is DEPRECATED!";
2047
+  _deprecate('0.24', "register_tag_processor is DEPRECATED!");
2045 2048
   # Merge tag
2046 2049
   my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
2047 2050
   $self->{_tags} = {%{$self->{_tags} || {}}, %{$tag_processors}};
... ...
@@ -2052,7 +2055,7 @@ sub register_tag_processor {
2052 2055
 sub default_bind_filter {
2053 2056
   my $self = shift;
2054 2057
   
2055
-  warn "default_bind_filter is DEPRECATED!";
2058
+  _deprecate('0.24', "default_bind_filter is DEPRECATED!");
2056 2059
   
2057 2060
   if (@_) {
2058 2061
     my $fname = $_[0];
... ...
@@ -2076,7 +2079,7 @@ sub default_bind_filter {
2076 2079
 sub default_fetch_filter {
2077 2080
   my $self = shift;
2078 2081
 
2079
-  warn "default_fetch_filter is DEPRECATED!";
2082
+  _deprecate('0.24', "default_fetch_filter is DEPRECATED!");
2080 2083
   
2081 2084
   if (@_) {
2082 2085
     my $fname = $_[0];
... ...
@@ -2100,21 +2103,21 @@ sub default_fetch_filter {
2100 2103
 # DEPRECATED!
2101 2104
 sub insert_param {
2102 2105
   my $self = shift;
2103
-  warn "insert_param is DEPRECATED! use values_clause instead";
2106
+  _deprecate('0.24', "insert_param is DEPRECATED! use values_clause instead");
2104 2107
   return $self->values_clause(@_);
2105 2108
 }
2106 2109
 
2107 2110
 # DEPRECATED!
2108 2111
 sub insert_param_tag {
2109
-  warn "insert_param_tag is DEPRECATED! " .
2110
-    "use insert_param instead!";
2112
+  _deprecate('0.24', "insert_param_tag is DEPRECATED! " .
2113
+    "use insert_param instead!");
2111 2114
   return shift->insert_param(@_);
2112 2115
 }
2113 2116
 
2114 2117
 # DEPRECATED!
2115 2118
 sub update_param_tag {
2116
-  warn "update_param_tag is DEPRECATED! " .
2117
-    "use update_param instead";
2119
+  _deprecate('0.24', "update_param_tag is DEPRECATED! " .
2120
+    "use update_param instead");
2118 2121
   return shift->update_param(@_);
2119 2122
 }
2120 2123
 # DEPRECATED!
... ...
@@ -3722,15 +3725,21 @@ executed SQL and bind values are printed to STDERR.
3722 3725
 
3723 3726
 DEBUG output encoding. Default to UTF-8.
3724 3727
 
3725
-=head2 C<DBIX_CUSTOM_TAG_PARSE>
3726
-
3727
-If you set DBIX_CUSTOM_TAG_PARSE to 0, tag parsing is off.
3728
-
3729 3728
 =head2 C<DBIX_CUSTOM_DISABLE_MODEL_EXECUTE>
3730 3729
 
3731 3730
 If you set DBIX_CUSTOM_DISABLE_MODEL_EXECUTE to 1,
3732 3731
 L<DBIx::Custom::Model> execute method call L<DBIx::Custom> execute.
3733 3732
 
3733
+=head2 C<DBIX_CUSTOM_SUPPRESS_DEPRECATION>
3734
+
3735
+  $ENV{DBIX_CUSTOM_SUPPRESS_DEPRECATION} = '0.25';
3736
+
3737
+Suppress deprecation warnings before specified version.
3738
+
3739
+=head2 C<DBIX_CUSTOM_TAG_PARSE>
3740
+
3741
+If you set DBIX_CUSTOM_TAG_PARSE to 0, tag parsing is off.
3742
+
3734 3743
 =head1 DEPRECATED FUNCTIONALITY
3735 3744
 
3736 3745
 L<DBIx::Custom>
... ...
@@ -3834,6 +3843,7 @@ L<DBIx::Custom::Result>
3834 3843
   filter_check # will be removed at 2017/1/1
3835 3844
   
3836 3845
   # Methods
3846
+  column (from 0.25) # will be removed at 2017/2/1
3837 3847
   fetch_first # will be removed at 2017/2/1
3838 3848
   fetch_hash_first # will be removed 2017/2/1
3839 3849
   filter_on # will be removed at 2017/1/1
... ...
@@ -3855,14 +3865,15 @@ L<DBIx::Custom::Order>
3855 3865
 
3856 3866
 =head1 BACKWARDS COMPATIBILITY POLICY
3857 3867
 
3858
-If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3859
-except for attribute method.
3860
-You can check all DEPRECATED functionalities by document.
3861
-DEPRECATED functionality is removed after five years,
3862
-but if at least one person use the functionality and tell me that thing
3868
+If a feature is DEPRECATED, you can know it by DEPRECATED warnings.
3869
+DEPRECATED feature is removed after C<five years>,
3870
+but if at least one person use the feature and tell me that thing
3863 3871
 I extend one year each time he tell me it.
3864 3872
 
3865
-EXPERIMENTAL functionality will be changed without warnings.
3873
+DEPRECATION warnings can be suppressed by C<DBIX_CUSTOM_SUPPRESS_DEPRECATION>
3874
+environment variable.
3875
+
3876
+EXPERIMENTAL features will be changed without warnings.
3866 3877
 
3867 3878
 =head1 BUGS
3868 3879
 
+5 -5
lib/DBIx/Custom/Mapper.pm
... ...
@@ -4,7 +4,7 @@ use Object::Simple -base;
4 4
 use DBIx::Custom::NotExists;
5 5
 
6 6
 use Carp 'croak';
7
-use DBIx::Custom::Util '_subname';
7
+use DBIx::Custom::Util qw/_subname _deprecate/;
8 8
 
9 9
 # Carp trust relationship
10 10
 push @DBIx::Custom::CARP_NOT, __PACKAGE__;
... ...
@@ -43,13 +43,13 @@ sub map {
43 43
     }
44 44
     elsif (!ref $mapping) {
45 45
       $new_key = $mapping;
46
-      warn qq/map method's string value "$mapping" is DEPRECATED. / .
47
-           qq/use {key => ...} syntax instead/
46
+      _deprecate('0.24', qq/map method's string value "$mapping" is DEPRECATED. / .
47
+        qq/use {key => ...} syntax instead/);
48 48
     }
49 49
     elsif (ref $mapping eq 'CODE') {
50 50
       $value = $mapping;
51
-      warn qq/map method's code reference value "$mapping" is DEPRECATED. / .
52
-           qq/use {value => ...} syntax instead/
51
+      _deprecate('0.24', qq/map method's code reference value "$mapping" is DEPRECATED. / .
52
+        qq/use {value => ...} syntax instead/);
53 53
     }
54 54
     
55 55
     $new_key = $key unless defined $new_key;
+8 -7
lib/DBIx/Custom/Model.pm
... ...
@@ -2,7 +2,7 @@ package DBIx::Custom::Model;
2 2
 use Object::Simple -base;
3 3
 
4 4
 use Carp 'croak';
5
-use DBIx::Custom::Util '_subname';
5
+use DBIx::Custom::Util qw/_subname _deprecate/;
6 6
 
7 7
 # Carp trust relationship
8 8
 push @DBIx::Custom::CARP_NOT, __PACKAGE__;
... ...
@@ -93,11 +93,12 @@ sub execute {
93 93
       $self->dbi->execute(@_);
94 94
   }
95 95
   else {
96
-    warn "DBIx::Custom::Model execute method is DEPRECATED! " .
97
-     "use DBIx::Custom execute method. " .
98
-     "If you want to call DBIx::Custom execute method directory from model, " .
99
-     "set \$ENV{DBIX_CUSTOM_DISABLE_MODEL_EXECUTE} to 1 " .
100
-     "until DBIx::Custom::Model execute method is removed in the future." ;
96
+    _deprecate('0.24', "DBIx::Custom::Model execute method is DEPRECATED! " .
97
+      "use DBIx::Custom execute method. " .
98
+      "If you want to call DBIx::Custom execute method directory from model, " .
99
+      "set \$ENV{DBIX_CUSTOM_DISABLE_MODEL_EXECUTE} to 1 " .
100
+      "until DBIx::Custom::Model execute method is removed in the future." );
101
+    
101 102
     return $self->dbi->execute(
102 103
       shift,
103 104
       shift,
... ...
@@ -162,7 +163,7 @@ has 'updated_at';
162 163
 
163 164
 # DEPRECATED!
164 165
 sub method {
165
-  warn "method method is DEPRECATED! use helper instead";
166
+  _deprecate('0.24', "method method is DEPRECATED! use helper instead");
166 167
   return shift->helper(@_);
167 168
 }
168 169
 
+4 -2
lib/DBIx/Custom/Order.pm
... ...
@@ -1,5 +1,7 @@
1 1
 package DBIx::Custom::Order;
2 2
 use Object::Simple -base;
3
+use DBIx::Custom::Util '_deprecate';
4
+
3 5
 use overload
4 6
   'bool'   => sub {1},
5 7
   '""'     => sub { shift->to_string },
... ...
@@ -13,8 +15,8 @@ sub prepend {
13 15
   
14 16
   for my $order (reverse @_) {
15 17
     if (ref $order eq 'ARRAY') {
16
-      warn "prepend method receiving array reference is DEPRECATED! " .
17
-           "use q method to quote column name.";
18
+      _deprecate('0.24', "prepend method receiving array reference is DEPRECATED! " .
19
+        "use q method to quote column name.");
18 20
       my $column = shift @$order;
19 21
       $column = $self->dbi->q($column) if defined $column;
20 22
       my $derection = shift @$order;
-63
lib/DBIx/Custom/Pool.pm
... ...
@@ -1,63 +0,0 @@
1
-package DBIx::Custom::Pool;
2
-use Object::Simple -base;
3
-use Carp 'croak';
4
-use Digest::MD5 'md5_hex';
5
-
6
-has count => 5;
7
-
8
-sub prepare {
9
-  my ($self, $cb) = @_;
10
-  
11
-  my $count = $self->count;
12
-  for (my $i = 0; $i < $count; $i++) {
13
-    my $dbi = $cb->();
14
-    
15
-    my $id = $self->_id;
16
-    
17
-    $self->{_pool}{$id} = $dbi;
18
-  }
19
-  return $self;
20
-}
21
-
22
-sub get {
23
-  my $self = shift;
24
-  
25
-  my @ids = keys %{$self->{_pool}};
26
-  croak "Pool is empty" unless @ids;
27
-  my $id = $ids[0];
28
-  my $dbi = delete $self->{_pool}{$id};
29
-  $self->{_borrow}{$id} = 1;
30
-  $dbi->{_pool_id} = $id;
31
-  return $dbi;
32
-}
33
-
34
-sub back {
35
-  my ($self, $dbi) = @_;
36
-  my $id = $dbi->{_pool_id};
37
-  return unless ref $dbi && defined $id;
38
-  croak "This DBIx::Custom object is already returned back"
39
-    if $self->{_pool}{$id};
40
-  delete $self->{_borrow}{$id};
41
-  $self->{_pool}{$id} = $dbi;
42
-  
43
-  return $self;
44
-}
45
-
46
-sub _id {
47
-  my $self = shift;
48
-  my $id;
49
-  do { $id = md5_hex('c' . time . rand 999) }
50
-    while $self->{_pool}->{$id} || $self->{_borrow}->{$id};
51
-  return $id;
52
-}
53
-
54
-1;
55
-
56
-=head1 NAME
57
-
58
-DBIx::Custom::Pool
59
-
60
-=head1 DESCRIPTION
61
-
62
-DBI Pool. this module is very experimental.
63
-
+4 -4
lib/DBIx/Custom/Query.pm
... ...
@@ -2,7 +2,7 @@ package DBIx::Custom::Query;
2 2
 use Object::Simple -base;
3 3
 
4 4
 use Carp 'croak';
5
-use DBIx::Custom::Util '_subname';
5
+use DBIx::Custom::Util qw/_subname _deprecate/;
6 6
 
7 7
 has [qw/sth statement/],
8 8
   sql => '',
... ...
@@ -11,7 +11,7 @@ has [qw/sth statement/],
11 11
 # DEPRECATED!
12 12
 has 'default_filter';
13 13
 sub filters {
14
-  warn "DBIx::Custom::Query filters attribute method is DEPRECATED!";
14
+  _depredcate('0.24', "DBIx::Custom::Query filters attribute method is DEPRECATED!");
15 15
   my $self = shift;
16 16
   if (@_) {
17 17
     $self->{filters} = $_[0];
... ...
@@ -22,7 +22,7 @@ sub filters {
22 22
 
23 23
 # DEPRECATED!
24 24
 sub tables {
25
-  warn "DBIx::Custom::Query tables attribute method is DEPRECATED!";
25
+  _deprecate('0.24', "DBIx::Custom::Query tables attribute method is DEPRECATED!");
26 26
   my $self = shift;
27 27
   if (@_) {
28 28
     $self->{tables} = $_[0];
... ...
@@ -33,7 +33,7 @@ sub tables {
33 33
 
34 34
 #DEPRECATED!
35 35
 sub filter {
36
-  Carp::carp "DBIx::Custom::Query filter method is DEPRECATED!";
36
+  _deprecate('0.24', "DBIx::Custom::Query filter method is DEPRECATED!");
37 37
   my $self = shift;
38 38
   if (@_) {
39 39
     my $filter = {};
+5 -5
lib/DBIx/Custom/QueryBuilder.pm
... ...
@@ -5,7 +5,7 @@ use Object::Simple -base;
5 5
 
6 6
 use Carp 'croak';
7 7
 use DBIx::Custom::Query;
8
-use DBIx::Custom::Util '_subname';
8
+use DBIx::Custom::Util qw/_subname _deprecate/;
9 9
 
10 10
 # Carp trust relationship
11 11
 push @DBIx::Custom::CARP_NOT, __PACKAGE__;
... ...
@@ -17,8 +17,8 @@ sub build_query {
17 17
 
18 18
   my $query = $self->_parse_tag($sql);
19 19
   my $tag_count = delete $query->{tag_count};
20
-  warn qq/Tag system such as {? name} is DEPRECATED! / .
21
-      qq/use parameter system such as :name instead/
20
+  _deprecate('0.24', qq/Tag system such as {? name} is DEPRECATED! / .
21
+      qq/use parameter system such as :name instead/)
22 22
     if $tag_count;
23 23
   my $query2 = $self->_parse_parameter($query->sql);
24 24
   $query->sql($query2->sql);
... ...
@@ -70,7 +70,7 @@ has tags => sub { {} };
70 70
 sub register_tag {
71 71
   my $self = shift;
72 72
   
73
-  warn "register_tag is DEPRECATED!";
73
+  _deprecate('0.24', "register_tag is DEPRECATED!");
74 74
   
75 75
   # Merge tag
76 76
   my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
... ...
@@ -260,7 +260,7 @@ has tag_processors => sub { {} };
260 260
 # DEPRECATED!
261 261
 sub register_tag_processor {
262 262
   my $self = shift;
263
-  warn "register_tag_processor is DEPRECATED!";
263
+  _deprecate('0.24', "register_tag_processor is DEPRECATED!");
264 264
   # Merge tag
265 265
   my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
266 266
   $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
+38 -26
lib/DBIx/Custom/Result.pm
... ...
@@ -2,22 +2,13 @@ package DBIx::Custom::Result;
2 2
 use Object::Simple -base;
3 3
 
4 4
 use Carp 'croak';
5
-use DBIx::Custom::Util qw/_array_to_hash _subname/;
5
+use DBIx::Custom::Util qw/_array_to_hash _subname _deprecate/;
6 6
 
7 7
 has [qw/dbi sth/],
8 8
   stash => sub { {} };
9 9
 
10 10
 *all = \&fetch_hash_all;
11 11
 
12
-sub column {
13
-  my $self = shift;
14
-  
15
-  my $column = [];
16
-  my $rows = $self->fetch_all;
17
-  push @$column, $_->[0] for @$rows;
18
-  return $column;
19
-}
20
-
21 12
 sub fetch {
22 13
   my $self = shift;
23 14
   
... ...
@@ -350,6 +341,15 @@ sub value {
350 341
   return $value;
351 342
 }
352 343
 
344
+sub values {
345
+  my $self = shift;
346
+  
347
+  my $values = [];
348
+  my $rows = $self->fetch_all;
349
+  push @$values, $_->[0] for @$rows;
350
+  return $values;
351
+}
352
+
353 353
 sub _cache {
354 354
   my $self = shift;
355 355
   $self->{_type_map} = {};
... ...
@@ -367,23 +367,35 @@ sub _cache {
367 367
   $self->{_cache} = 1;
368 368
 }
369 369
 
370
+# DEPRECATED!
371
+sub column {
372
+  my $self = shift;
373
+  
374
+  _deprecate('0.25', "DBIx::Custom::Result::column method is DEPRECATED. "
375
+    . "use values method instead");
376
+  
377
+  return $self->values(@_);
378
+}
379
+
370 380
 # DEPRECATED!
371 381
 sub fetch_hash_first {
372 382
   my $self = shift;
373
-  warn "DBIx::Custom::Result::fetch_hash_first is DEPRECATED! use fetch_hash_one instead";
383
+  _deprecate('0.24', "DBIx::Custom::Result::fetch_hash_first is DEPRECATED! "
384
+    . "use fetch_hash_one instead");
374 385
   return $self->fetch_hash_one(@_);
375 386
 }
376 387
 
377 388
 # DEPRECATED!
378 389
 sub fetch_first {
379 390
   my $self = shift;
380
-  warn "DBIx::Custom::Result::fetch_first is DEPRECATED! use fetch_one instead";
391
+  _deprecate('0.24', "DBIx::Custom::Result::fetch_first is DEPRECATED! "
392
+    . " use fetch_one instead");
381 393
   return $self->fetch_one(@_);
382 394
 }
383 395
 
384 396
 # DEPRECATED!
385 397
 sub filter_off {
386
-  warn "filter_off method is DEPRECATED!";
398
+  _deprecate('0.24', "filter_off method is DEPRECATED!");
387 399
   my $self = shift;
388 400
   $self->{filter_off} = 1;
389 401
   return $self;
... ...
@@ -391,7 +403,7 @@ sub filter_off {
391 403
 
392 404
 # DEPRECATED!
393 405
 sub filter_on {
394
-  warn "filter_on method is DEPRECATED!";
406
+  _deprecated('0.24', "filter_on method is DEPRECATED!");
395 407
   my $self = shift;
396 408
   $self->{filter_off} = 0;
397 409
   return $self;
... ...
@@ -399,7 +411,7 @@ sub filter_on {
399 411
 
400 412
 # DEPRECATED!
401 413
 sub end_filter {
402
-  warn "end_filter method is DEPRECATED!";
414
+  _deprecate('0.24', "end_filter method is DEPRECATED!");
403 415
   my $self = shift;
404 416
   if (@_) {
405 417
     my $end_filter = {};
... ...
@@ -427,21 +439,21 @@ sub end_filter {
427 439
 }
428 440
 # DEPRECATED!
429 441
 sub remove_end_filter {
430
-  warn "remove_end_filter is DEPRECATED!";
442
+  _deprecate('0.24', "remove_end_filter is DEPRECATED!");
431 443
   my $self = shift;
432 444
   $self->{end_filter} = {};
433 445
   return $self;
434 446
 }
435 447
 # DEPRECATED!
436 448
 sub remove_filter {
437
-  warn "remove_filter is DEPRECATED!";
449
+  _deprecate('0.24', "remove_filter is DEPRECATED!");
438 450
   my $self = shift;
439 451
   $self->{filter} = {};
440 452
   return $self;
441 453
 }
442 454
 # DEPRECATED!
443 455
 sub default_filter {
444
-  warn "default_filter is DEPRECATED!";
456
+  _deprecate('0.24', "default_filter is DEPRECATED!");
445 457
   my $self = shift;
446 458
   if (@_) {
447 459
     my $fname = $_[0];
... ...
@@ -524,14 +536,6 @@ and implements the following new ones.
524 536
 
525 537
 Same as C<fetch_hash_all>.
526 538
 
527
-=head2 C<column>
528
-
529
-  my $column = $result->column;
530
-
531
-Get first column's all values.
532
-
533
-  my $names = $dbi->select('name', table => 'book')->column;
534
-
535 539
 =head2 C<fetch>
536 540
 
537 541
   my $row = $result->fetch;
... ...
@@ -756,4 +760,12 @@ Get first column's first value.
756 760
 
757 761
   my $count = $dbi->select('count(*)')->value;
758 762
 
763
+=head2 C<values>
764
+
765
+  my $values = $result->values;
766
+
767
+Get first column's values.
768
+
769
+  my $names = $dbi->select('name', table => 'book')->values;
770
+
759 771
 =cut
+10 -1
lib/DBIx/Custom/Util.pm
... ...
@@ -5,7 +5,7 @@ use warnings;
5 5
 
6 6
 use base 'Exporter';
7 7
 
8
-our @EXPORT_OK = qw/_array_to_hash _subname/;
8
+our @EXPORT_OK = qw/_array_to_hash _subname _deprecate/;
9 9
 
10 10
 sub _array_to_hash {
11 11
   my $array = shift;
... ...
@@ -29,6 +29,15 @@ sub _array_to_hash {
29 29
 
30 30
 sub _subname { '(' . (caller 1)[3] . ')' }
31 31
 
32
+sub _deprecate {
33
+  my ($deprecated_version, $message) = @_;
34
+  
35
+  my $suppress_version = $ENV{DBIX_CUSTOM_SUPPRESS_DEPRECATION} || 0;
36
+  
37
+  warn "$message (Version: $deprecated_version) (" . (caller 1)[3] . ")\n"
38
+    if $suppress_version < $deprecated_version;
39
+}
40
+
32 41
 1;
33 42
 
34 43
 =head1 NAME
+9 -1
t/common.t
... ...
@@ -5,6 +5,8 @@ use Encode qw/encode_utf8/;
5 5
 use FindBin;
6 6
 use Scalar::Util 'isweak';
7 7
 
8
+$ENV{DBIX_CUSTOM_SUPPRESS_DEPRECATION} = '0.25';
9
+
8 10
 my $dbi;
9 11
 
10 12
 plan skip_all => $ENV{DBIX_CUSTOM_SKIP_MESSAGE} || 'common.t is always skipped'
... ...
@@ -13,7 +15,6 @@ plan skip_all => $ENV{DBIX_CUSTOM_SKIP_MESSAGE} || 'common.t is always skipped'
13 15
 
14 16
 plan 'no_plan';
15 17
 
16
-$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
17 18
 sub test { print "# $_[0]\n" }
18 19
 
19 20
 # Dot to under score
... ...
@@ -403,6 +404,7 @@ $rows = $result->fetch_hash_all;
403 404
 is_deeply($rows, [{$key1 => 1, $key2 => 2}, {$key1 => 3, $key2 => 4}], "all");
404 405
 
405 406
 is_deeply($dbi->select($key1, table => $table1)->column, [1, 3]);
407
+is_deeply($dbi->select($key1, table => $table1)->values, [1, 3]);
406 408
 
407 409
 is($dbi->select('count(*)', table => $table1)->value, 2);
408 410
 ok(!defined $dbi->select($key1, table => $table1, where => {$key1 => 10})->value);
... ...
@@ -4190,6 +4192,12 @@ $model = $dbi->model($table1);
4190 4192
 $model->columns([$key1, $key2]);
4191 4193
 is_deeply($model->columns, [$key1, $key2]);
4192 4194
 
4195
+test 'columns';
4196
+$dbi = MyDBI1->connect;
4197
+$model = $dbi->model($table1);
4198
+$model->columns([$key1, $key2]);
4199
+is_deeply($model->columns, [$key1, $key2]);
4200
+
4193 4201
 test 'setup_model';
4194 4202
 $dbi = MyDBI1->connect;
4195 4203
 $dbi->user_table_info($user_table_info);