all filter can receive array...
|
1 |
package DBIx::Custom::Util; |
2 | ||
3 |
use strict; |
|
4 |
use warnings; |
|
5 | ||
cleanup
|
6 |
use base 'Exporter'; |
7 | ||
- added DBIX_CUSTOM_SUPPRESS...
|
8 |
our @EXPORT_OK = qw/_array_to_hash _subname _deprecate/; |
cleanup
|
9 | |
10 |
sub _array_to_hash { |
|
cleanup
|
11 |
my $array = shift; |
12 |
|
|
13 |
return $array if ref $array eq 'HASH'; |
|
14 |
return unless $array; |
|
15 |
|
|
16 |
my $hash = {}; |
|
17 |
|
|
18 |
for (my $i = 0; $i < @$array; $i += 2) { |
|
19 |
my $key = $array->[$i]; |
|
20 |
my $f = $array->[$i + 1]; |
|
all filter can receive array...
|
21 |
|
cleanup
|
22 |
if (ref $key eq 'ARRAY') { |
23 |
for my $k (@$key) { $hash->{$k} = $f } |
|
all filter can receive array...
|
24 |
} |
cleanup
|
25 |
else { $hash->{$key} = $f } |
26 |
} |
|
27 |
return $hash; |
|
all filter can receive array...
|
28 |
} |
29 | ||
cleanup
|
30 |
sub _subname { '(' . (caller 1)[3] . ')' } |
31 | ||
- added DBIX_CUSTOM_SUPPRESS...
|
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 | ||
all filter can receive array...
|
41 |
1; |
42 | ||
43 |
=head1 NAME |
|
44 | ||
45 |
DBIx::Custom::Util - Utility class |
|
46 |