line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
use strict; |
2
|
1
|
|
|
1
|
|
381
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
3
|
1
|
|
|
1
|
|
4
|
use DBIx::Inspector 0.06; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
313
|
use Carp (); |
|
1
|
|
|
|
|
4407
|
|
|
1
|
|
|
|
|
19
|
|
5
|
1
|
|
|
1
|
|
5
|
use DBI (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
6
|
1
|
|
|
1
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
481
|
|
7
|
|
|
|
|
|
|
my %SQLTYPE2NAME = map { &{$DBI::{$_}} => $_ } @{$DBI::EXPORT_TAGS{sql_types}}; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
my $class = shift; |
10
|
|
|
|
|
|
|
my %args = @_==1 ? %{$_[0]} : @_; |
11
|
5
|
|
|
5
|
1
|
26282
|
|
12
|
5
|
50
|
|
|
|
23
|
my $dbh = $args{dbh} or Carp::croak("missing mandatory parameter 'dbh'"); |
|
0
|
|
|
|
|
0
|
|
13
|
|
|
|
|
|
|
my $namespace = $args{namespace} or Carp::croak("missing mandatory parameter 'namespace'"); |
14
|
5
|
50
|
|
|
|
12
|
|
15
|
5
|
50
|
|
|
|
18
|
my $inspector = DBIx::Inspector->new(dbh => $dbh); |
16
|
|
|
|
|
|
|
|
17
|
5
|
|
|
|
|
24
|
my $ret = ""; |
18
|
|
|
|
|
|
|
|
19
|
5
|
|
|
|
|
2600
|
if ( ref $args{tables} eq "ARRAY" ) { |
20
|
|
|
|
|
|
|
for my $table_name (@{ $args{tables} }) { |
21
|
5
|
100
|
|
|
|
19
|
$ret .= _render_table($inspector->table($table_name), \%args); |
|
|
100
|
|
|
|
|
|
22
|
1
|
|
|
|
|
2
|
} |
|
1
|
|
|
|
|
3
|
|
23
|
2
|
|
|
|
|
5
|
} |
24
|
|
|
|
|
|
|
elsif ( $args{tables} ) { |
25
|
|
|
|
|
|
|
$ret .= _render_table($inspector->table($args{tables}), \%args); |
26
|
|
|
|
|
|
|
} |
27
|
1
|
|
|
|
|
10
|
else { |
28
|
|
|
|
|
|
|
$ret .= "package ${namespace}::Schema;\n"; |
29
|
|
|
|
|
|
|
$ret .= "use strict;\n"; |
30
|
3
|
|
|
|
|
6
|
$ret .= "use warnings;\n"; |
31
|
3
|
|
|
|
|
6
|
$ret .= "use DBI qw/:sql_types/;\n"; |
32
|
3
|
|
|
|
|
5
|
$ret .= "use Teng::Schema::Declare;\n"; |
33
|
3
|
|
|
|
|
4
|
$ret .= "base_row_class '$args{base_row_class}';\n" if $args{base_row_class}; |
34
|
3
|
|
|
|
|
5
|
$ret .= "default_row_class_prefix '$args{default_row_class_prefix}';\n" if $args{default_row_class_prefix}; |
35
|
3
|
100
|
|
|
|
10
|
for my $table_info (sort { $a->name cmp $b->name } $inspector->tables) { |
36
|
3
|
100
|
|
|
|
9
|
$ret .= _render_table($table_info, \%args); |
37
|
3
|
|
|
|
|
11
|
} |
|
9
|
|
|
|
|
1542
|
|
38
|
9
|
|
|
|
|
29
|
$ret .= "1;\n"; |
39
|
|
|
|
|
|
|
} |
40
|
3
|
|
|
|
|
17
|
|
41
|
|
|
|
|
|
|
return $ret; |
42
|
|
|
|
|
|
|
} |
43
|
5
|
|
|
|
|
35
|
|
44
|
|
|
|
|
|
|
my ($table_info, $args) = @_; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $ret = ""; |
47
|
12
|
|
|
12
|
|
1198
|
|
48
|
|
|
|
|
|
|
$ret .= "table {\n"; |
49
|
12
|
|
|
|
|
17
|
$ret .= sprintf(" name '%s';\n", $table_info->name); |
50
|
|
|
|
|
|
|
$ret .= sprintf(" pk %s;\n", join ',' , map { q{'}.$_->name.q{'} } $table_info->primary_key); |
51
|
12
|
|
|
|
|
18
|
$ret .= " columns (\n"; |
52
|
12
|
|
|
|
|
23
|
for my $col ($table_info->columns) { |
53
|
12
|
|
|
|
|
68
|
if ($col->data_type) { |
|
12
|
|
|
|
|
13575
|
|
54
|
12
|
|
|
|
|
108
|
$ret .= sprintf(" {name => '%s', type => %s},\n", $col->name, $SQLTYPE2NAME{$col->data_type} || $col->data_type); |
55
|
12
|
|
|
|
|
28
|
} else { |
56
|
48
|
50
|
|
|
|
11490
|
$ret .= sprintf(" '%s',\n", $col->name); |
57
|
0
|
|
0
|
|
|
0
|
} |
58
|
|
|
|
|
|
|
} |
59
|
48
|
|
|
|
|
150
|
$ret .= " );\n"; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
if (my $rule = $args->{inflate}->{$table_info->name}) { |
62
|
12
|
|
|
|
|
106
|
$ret .= $rule; |
63
|
|
|
|
|
|
|
} |
64
|
12
|
100
|
|
|
|
33
|
|
65
|
1
|
|
|
|
|
33
|
$ret .= "};\n\n"; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
return $ret; |
68
|
12
|
|
|
|
|
63
|
} |
69
|
|
|
|
|
|
|
|
70
|
12
|
|
|
|
|
59
|
1; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 NAME |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Teng::Schema::Dumper - Schema code generator |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 SYNOPSIS |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
use DBI; |
79
|
|
|
|
|
|
|
use Teng::Schema::Dumper; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my $dbh = DBI->connect(@dsn) or die; |
82
|
|
|
|
|
|
|
print Teng::Schema::Dumper->dump( |
83
|
|
|
|
|
|
|
dbh => $dbh, |
84
|
|
|
|
|
|
|
namespace => 'Mock::DB', |
85
|
|
|
|
|
|
|
inflate => +{ |
86
|
|
|
|
|
|
|
user => q| |
87
|
|
|
|
|
|
|
use Mock::Inflate::Name; |
88
|
|
|
|
|
|
|
inflate 'name' => sub { |
89
|
|
|
|
|
|
|
my ($col_value) = @_; |
90
|
|
|
|
|
|
|
return Mock::Inflate::Name->new(name => $col_value); |
91
|
|
|
|
|
|
|
}; |
92
|
|
|
|
|
|
|
deflate 'name' => sub { |
93
|
|
|
|
|
|
|
my ($col_value) = @_; |
94
|
|
|
|
|
|
|
return ref $col_value ? $col_value->name : $col_value . '_deflate'; |
95
|
|
|
|
|
|
|
}; |
96
|
|
|
|
|
|
|
inflate qr/.+oo/ => sub { |
97
|
|
|
|
|
|
|
my ($col_value) = @_; |
98
|
|
|
|
|
|
|
return Mock::Inflate::Name->new(name => $col_value); |
99
|
|
|
|
|
|
|
}; |
100
|
|
|
|
|
|
|
deflate qr/.+oo/ => sub { |
101
|
|
|
|
|
|
|
my ($col_value) = @_; |
102
|
|
|
|
|
|
|
return ref $col_value ? $col_value->name : $col_value . '_deflate'; |
103
|
|
|
|
|
|
|
}; |
104
|
|
|
|
|
|
|
|, |
105
|
|
|
|
|
|
|
}, |
106
|
|
|
|
|
|
|
); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 DESCRIPTION |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
This module generates the Perl code to generate L<Teng::Schema> instance. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
You can use it by C<do "my/schema.pl"> or embed it to the package. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 METHODS |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=over 4 |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item C<Teng::Schema::Dumper-E<gt>dump(dbh =E<gt> $dbh, namespace =E<gt> $namespace)> |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
This is the method to generate code from DB. It returns the Perl5 code in string. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
The arguments are: |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=over 4 |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item C<dbh> |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Database handle from DBI. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item C<namespace> |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
your project Teng namespace. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item C<base_row_class> |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Specify the default base row class for L<Teng::Schema::Declare>. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item C<default_row_class_prefix> |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Specify the default row class prefix for L<Teng::Schema::Declare>. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=back |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=back |
145
|
|
|
|
|
|
|
|