Newer Older
41 lines | 0.702kb
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1
package DBIx::Custom::Util;
2

            
3
use strict;
4
use warnings;
5

            
cleanup
Yuki Kimoto authored on 2011-04-25
6
use base 'Exporter';
7

            
8
our @EXPORT_OK = qw/_array_to_hash _subname/;
9

            
10
sub _array_to_hash {
cleanup
Yuki Kimoto authored on 2011-03-21
11
    my $array = shift;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
12
    
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
13
    return $array if ref $array eq 'HASH';
cleanup
Yuki Kimoto authored on 2011-03-21
14
    return unless $array;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
15
    
cleanup
Yuki Kimoto authored on 2011-03-21
16
    my $hash = {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
17
    
cleanup
Yuki Kimoto authored on 2011-03-21
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...
Yuki Kimoto authored on 2011-02-25
21
        
cleanup
Yuki Kimoto authored on 2011-03-21
22
        if (ref $key eq 'ARRAY') {
23
            foreach my $k (@$key) {
24
                $hash->{$k} = $f;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
25
            }
26
        }
27
        else {
cleanup
Yuki Kimoto authored on 2011-03-21
28
            $hash->{$key} = $f;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
29
        }
30
    }
cleanup
Yuki Kimoto authored on 2011-03-21
31
    return $hash;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
32
}
33

            
cleanup
Yuki Kimoto authored on 2011-04-25
34
sub _subname { '(' . (caller 1)[3] . ')' }
35

            
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
36
1;
37

            
38
=head1 NAME
39

            
40
DBIx::Custom::Util - Utility class
41