File Coverage

blib/lib/Teng/Schema/Table.pm
Criterion Covered Total %
statement 61 81 75.3
branch 8 16 50.0
condition 2 2 100.0
subroutine 12 16 75.0
pod 8 9 88.8
total 91 124 73.3


line stmt bran cond sub pod time code
1             use strict;
2 70     70   85243 use warnings;
  70         148  
  70         1616  
3 70     70   282 use Class::Accessor::Lite
  70         128  
  70         2271  
4             rw => [ qw(
5 70         561 name
6             primary_keys
7             columns
8             escaped_columns
9             sql_types
10             row_class
11             base_row_class
12             ) ]
13             ;
14 70     70   760 use Carp ();
  70         1140  
15 70     70   8321 use Class::Load ();
  70         133  
  70         1201  
16 70     70   1489  
  70         52026  
  70         7066  
17             my ($class, %args) = @_;
18             my $self = bless {
19 248     248 1 3446 deflators => [],
20 248         2025 inflators => [],
21             escaped_columns => {},
22             base_row_class => 'Teng::Row',
23             %args
24             }, $class;
25              
26             # load row class
27             my $row_class = $self->row_class;
28             Class::Load::load_optional_class($row_class) or do {
29 248         918 # make row class automatically
30 248 100       1541 Class::Load::load_class($self->base_row_class);
31             no strict 'refs'; @{"$row_class\::ISA"} = ($self->base_row_class);
32 243         84626 };
33 70     70   426 for my $col (@{$self->columns}) {
  70         123  
  70         4199  
  243         15601  
  243         4569  
34             no strict 'refs';
35 248         1090 unless ($row_class->can($col)) {
  248         1588  
36 70     70   409 *{"$row_class\::$col"} = $row_class->generate_column_accessor($col);
  70         191  
  70         40192  
37 741 100       4897 }
38 737         1785 }
  737         2310  
39             $self->row_class($row_class);
40              
41 248         755 return $self;
42             }
43 248         2117  
44             my ($self, $column_name) = @_;
45             $self->sql_types->{ $column_name };
46             }
47 337     337 1 3205  
48 337         664 my ($self, $rule, $code) = @_;
49             if ( ref $rule ne 'Regexp' ) {
50             $rule = qr/^\Q$rule\E$/;
51             }
52 0     0 1 0 unless (ref($code) eq 'CODE') {
53 0 0       0 Carp::croak('deflate code must be coderef.');
54 0         0 }
55             push @{ $self->{deflators} }, ( $rule, $code );
56 0 0       0 }
57 0         0  
58             my ($self, $rule, $code) = @_;
59 0         0 if ( ref $rule ne 'Regexp' ) {
  0         0  
60             $rule = qr/^\Q$rule\E$/;
61             }
62             unless (ref($code) eq 'CODE') {
63 0     0 1 0 Carp::croak('inflate code must be coderef.');
64 0 0       0 }
65 0         0 push @{ $self->{inflators} }, ( $rule, $code );
66             }
67 0 0       0  
68 0         0 my ($self, $col_name, $col_value) = @_;
69             my $rules = $self->{deflators};
70 0         0 my $i = 0;
  0         0  
71             my $max = @$rules;
72             while ( $i < $max ) {
73             my ($rule, $code) = @$rules[ $i, $i + 1 ];
74 343     343 1 672 if ($col_name =~ /$rule/) {
75 343         520 return $code->($col_value);
76 343         403 }
77 343         426 $i += 2;
78 343         678 }
79 70         147 return $col_value;
80 70 100       242 }
81 25         90  
82             my ($self, $col_name, $col_value) = @_;
83 45         74 my $rules = $self->{inflators};
84             my $i = 0;
85 318         779 my $max = @$rules;
86             while ( $i < $max ) {
87             my ($rule, $code) = @$rules[ $i, $i + 1 ];
88             if ($col_name =~ /$rule/) {
89 231     231 1 478 return $code->($col_value);
90 231         420 }
91 231         321 $i += 2;
92 231         344 }
93 231         556 return $col_value;
94 66         112 }
95 66 100       282  
96 33         104 my $self = shift;
97             return scalar @{ $self->{deflators} };
98 33         55 }
99              
100 198         630 my $self = shift;
101             return scalar @{ $self->{inflators} };
102             }
103              
104 0     0 1 0 my ($self, $dbh) = @_;
105 0         0  
  0         0  
106             $self->escaped_columns->{$dbh->{Driver}->{Name}} ||= [
107             map { \$dbh->quote_identifier($_) }
108             @{$self->columns}
109 0     0 1 0 ];
110 0         0 }
  0         0  
111              
112             1;
113              
114 472     472 0 5621  
115             =head1 NAME
116              
117 712         136677 Teng::Schema::Table - Teng table class.
118 472   100     1851  
  234         3993  
119             =head1 METHODS
120              
121             =over 4
122              
123             =item $table = Teng::Schema::Table->new
124              
125             create new Teng::Schema::Table's object.
126              
127             =item $table->get_sql_type
128              
129             get column SQL type.
130              
131             =item $table->add_deflator($column_rule, $code)
132              
133             add deflate code reference.
134              
135             =item $table->add_inflator($column_rule, $code)
136              
137             add inflate code reference.
138              
139             =item $table->call_deflate
140              
141             execute deflate.
142              
143             =item $table->call_inflate
144              
145             execute inflate.
146              
147             =item $table->has_deflators()
148              
149             Returns true if there are any deflators
150              
151             =item $table->has_inflators();
152              
153             Returns true if there are any inflators
154              
155             =back