- added DBIX_CUSTOM_SUPPRESS_DEPRECATION environment...
...varaible
| ... | ... |
@@ -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 |
| ... | ... |
@@ -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 |
|
| ... | ... |
@@ -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; |
| ... | ... |
@@ -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 |
|
| ... | ... |
@@ -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; |
| ... | ... |
@@ -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 |
- |
| ... | ... |
@@ -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,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}});
|
| ... | ... |
@@ -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 |
| ... | ... |
@@ -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 |
| ... | ... |
@@ -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); |