File Coverage

blib/lib/Teng/Schema/Dumper.pm
Criterion Covered Total %
statement 53 55 96.3
branch 14 18 77.7
condition 0 3 0.0
subroutine 7 7 100.0
pod 1 1 100.0
total 75 84 89.2


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