File Coverage

blib/lib/MySQL/Workbench/SQLiteSimple.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package MySQL::Workbench::SQLiteSimple;
2              
3             # ABSTRACT: Create a simple .sql file for SQLite
4              
5 1     1   24327 use warnings;
  1         2  
  1         28  
6 1     1   4 use strict;
  1         1  
  1         21  
7              
8 1     1   4 use Carp;
  1         4  
  1         43  
9 1     1   4 use File::Spec;
  1         1  
  1         15  
10 1     1   4 use List::Util qw(first);
  1         1  
  1         76  
11 1     1   467 use Moo;
  1         10687  
  1         5  
12 1     1   2129 use MySQL::Workbench::Parser;
  0            
  0            
13              
14             # ABSTRACT: create DBIC scheme for MySQL workbench .mwb files
15              
16             our $VERSION = '0.01';
17              
18             has output_path => ( is => 'ro', required => 1, default => sub { '.' } );
19             has file => ( is => 'ro', required => 1 );
20              
21             sub create_sql {
22             my $self = shift;
23            
24             my $parser = MySQL::Workbench::Parser->new( file => $self->file );
25             my @tables = @{ $parser->tables };
26              
27             my @tables_sql = $self->_create_tables( \@tables );
28              
29             $self->_write_files( @tables_sql );
30             }
31              
32             sub _write_files{
33             my ($self, @sqls) = @_;
34            
35             my $dir = $self->_untaint_path( $self->output_path || '.' );
36             my $path = File::Spec->catfile( $dir, 'sqlite.sql' );
37            
38             unless( -e $dir ){
39             $self->_mkpath( $dir );
40             }
41              
42             if( open my $fh, '>', $path ) {
43             print $fh join "\n\n", @sqls;
44             close $fh;
45             }
46             else{
47             croak "Couldn't create $path: $!";
48             }
49             }
50              
51             sub _untaint_path{
52             my ($self,$path) = @_;
53             ($path) = ( $path =~ /(.*)/ );
54             # win32 uses ';' for a path separator, assume others use ':'
55             my $sep = ($^O =~ /win32/i) ? ';' : ':';
56             # -T disallows relative directories in the PATH
57             $path = join $sep, grep !/^\.+$/, split /$sep/, $path;
58             return $path;
59             }
60              
61             sub _mkpath{
62             my ($self, $path) = @_;
63            
64             my @parts = split /[\\\/]/, $path;
65            
66             for my $i ( 0..$#parts ){
67             my $dir = File::Spec->catdir( @parts[ 0..$i ] );
68             $dir = $self->_untaint_path( $dir );
69             unless ( -e $dir ) {
70             mkdir $dir or die "$dir: $!";
71             }
72             }
73             }
74              
75             sub _create_tables {
76             my ($self, $tables) = @_;
77              
78             my @sqls;
79             for my $table ( @{ $tables } ) {
80            
81             my $name = $table->name;
82             my @columns = $self->_get_columns( $table );
83              
84             my $sql = sprintf q~CREATE TABLE `%s` (
85             %s,
86             PRIMARY KEY (%s)
87             );
88             ~, $name, join( ",\n ", @columns), join( ", ", @{ $table->primary_key || [] } );
89             push @sqls, $sql;
90             }
91              
92             return @sqls;
93             }
94              
95             sub _get_columns {
96             my ($self, $table) = @_;
97              
98             my @columns = @{ $table->columns };
99              
100             my @create_columns;
101              
102             for my $column ( @columns ) {
103             my $default_value = $column->default_value || '';
104             $default_value =~ s/'/\\'/g;
105              
106             my $datatype = $column->datatype;
107             my $sqlite_type = 'TEXT';
108             if ( first{ $datatype eq $_ }qw/SMALLINT INT INTEGER BIGINT MEDIUMINT/ ) {
109             $sqlite_type = 'INTEGER';
110             }
111              
112             my $name = $column->name;
113             my $not_null = $column->not_null ? 'NOT NULL' : '';
114             my $auto_increment = $column->autoincrement ? 'AUTOINCREMENT' : '';
115             my $single_column = sprintf q~%s %s %s %s~,
116             $name, $sqlite_type, $not_null, $auto_increment;
117              
118             push @create_columns, $single_column;
119             }
120              
121             return @create_columns;
122             }
123              
124             1;
125              
126             __END__