all filter can receive array...
|
1 |
package DBIx::Custom::Util; |
2 | ||
3 |
use strict; |
|
4 |
use warnings; |
|
5 | ||
cleanup
|
6 |
use base 'Exporter'; |
7 | ||
8 |
our @EXPORT_OK = qw/_array_to_hash _subname/; |
|
9 | ||
10 |
sub _array_to_hash { |
|
cleanup
|
11 |
my $array = shift; |
all filter can receive array...
|
12 |
|
adeed EXPERIMENTAL DBIx::Cus...
|
13 |
return $array if ref $array eq 'HASH'; |
cleanup
|
14 |
return unless $array; |
all filter can receive array...
|
15 |
|
cleanup
|
16 |
my $hash = {}; |
all filter can receive array...
|
17 |
|
cleanup
|
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 |
foreach my $k (@$key) { |
|
24 |
$hash->{$k} = $f; |
|
all filter can receive array...
|
25 |
} |
26 |
} |
|
27 |
else { |
|
cleanup
|
28 |
$hash->{$key} = $f; |
all filter can receive array...
|
29 |
} |
30 |
} |
|
cleanup
|
31 |
return $hash; |
all filter can receive array...
|
32 |
} |
33 | ||
cleanup
|
34 |
sub _subname { '(' . (caller 1)[3] . ')' } |
35 | ||
all filter can receive array...
|
36 |
1; |
37 | ||
38 |
=head1 NAME |
|
39 | ||
40 |
DBIx::Custom::Util - Utility class |
|
41 |