File Coverage

blib/lib/SQL/Translator/Parser/xSV.pm
Criterion Covered Total %
statement 67 68 98.5
branch 22 28 78.5
condition 15 25 60.0
subroutine 9 9 100.0
pod 0 1 0.0
total 113 131 86.2


line stmt bran cond sub pod time code
1             package SQL::Translator::Parser::xSV;
2              
3             =head1 NAME
4              
5             SQL::Translator::Parser::xSV - parser for arbitrarily delimited text files
6              
7             =head1 SYNOPSIS
8              
9             use SQL::Translator;
10             use SQL::Translator::Parser::xSV;
11              
12             my $translator = SQL::Translator->new(
13             parser => 'xSV',
14             parser_args => { field_separator => "\t" },
15             );
16              
17             =head1 DESCRIPTION
18              
19             Parses arbitrarily delimited text files. See the
20             Text::RecordParser manpage for arguments on how to parse the file
21             (e.g., C, C). Other arguments
22             include:
23              
24             =head1 OPTIONS
25              
26             =over
27              
28             =item * scan_fields
29              
30             Indicates that the columns should be scanned to determine data types
31             and field sizes. True by default.
32              
33             =item * trim_fields
34              
35             A shortcut to sending filters to Text::RecordParser, will create
36             callbacks that trim leading and trailing spaces from fields and headers.
37             True by default.
38              
39             =back
40              
41             Field names will automatically be normalized by
42             C.
43              
44             =cut
45              
46 1     1   6 use strict;
  1         2  
  1         24  
47 1     1   4 use warnings;
  1         2  
  1         38  
48             our @EXPORT;
49             our $VERSION = '1.6_3';
50              
51 1     1   4 use Exporter;
  1         2  
  1         28  
52 1     1   361 use Text::ParseWords qw(quotewords);
  1         1093  
  1         46  
53 1     1   431 use Text::RecordParser;
  1         25017  
  1         30  
54 1     1   6 use SQL::Translator::Utils qw(debug normalize_name);
  1         2  
  1         46  
55              
56 1     1   6 use base qw(Exporter);
  1         2  
  1         698  
57             @EXPORT = qw(parse);
58              
59             #
60             # Passed a SQL::Translator instance and a string containing the data
61             #
62             sub parse {
63 1     1 0 7 my ( $tr, $data ) = @_;
64 1         16 my $args = $tr->parser_args;
65             my $parser = Text::RecordParser->new(
66             field_separator => $args->{'field_separator'} || ',',
67 1   50     14 record_separator => $args->{'record_separator'} || "\n",
      50        
68             data => $data,
69             header_filter => \&normalize_name,
70             );
71              
72 21   50 21   1021 $parser->field_filter( sub { $_ = shift || ''; s/^\s+|\s+$//g; $_ } )
  21         61  
  21         40  
73 1 50 33     236 unless defined $args->{'trim_fields'} && $args->{'trim_fields'} == 0;
74              
75 1         36 my $schema = $tr->schema;
76 1         49 my $table = $schema->add_table( name => 'table1' );
77              
78             #
79             # Get the field names from the first row.
80             #
81 1         4 $parser->bind_header;
82 1         42 my @field_names = $parser->field_list;
83              
84 1         14 for ( my $i = 0; $i < @field_names; $i++ ) {
85 7 50       37 my $field = $table->add_field(
86             name => $field_names[$i],
87             data_type => 'char',
88             default_value => '',
89             size => 255,
90             is_nullable => 1,
91             is_auto_increment => undef,
92             ) or die $table->error;
93              
94 7 100       121 if ( $i == 0 ) {
95 1         17 $table->primary_key( $field->name );
96 1         13 $field->is_primary_key(1);
97             }
98             }
99              
100             #
101             # If directed, look at every field's values to guess size and type.
102             #
103 1 50 33     8 unless (
104             defined $args->{'scan_fields'} &&
105             $args->{'scan_fields'} == 0
106             ) {
107 1         3 my %field_info = map { $_, {} } @field_names;
  7         14  
108 1         4 while ( my $rec = $parser->fetchrow_hashref ) {
109 2         171 for my $field ( @field_names ) {
110 14 50       27 my $data = defined $rec->{ $field } ? $rec->{ $field } : '';
111 14         19 my $size = [ length $data ];
112 14         15 my $type;
113              
114 14 100 66     78 if ( $data =~ /^-?\d+$/ ) {
    100 100        
115 2         3 $type = 'integer';
116             }
117             elsif (
118             $data =~ /^-?[,\d]+\.[\d+]?$/
119             ||
120             $data =~ /^-?[,\d]+?\.\d+$/
121             ||
122             $data =~ /^-?\.\d+$/
123             ) {
124 2         3 $type = 'float';
125             my ( $w, $d ) =
126 2 100       6 map { s/,//g; length $_ || 1 } split( /\./, $data );
  4         5  
  4         11  
127 2         6 $size = [ $w + $d, $d ];
128             }
129             else {
130 10         15 $type = 'char';
131             }
132              
133 14         19 for my $i ( 0, 1 ) {
134 28 100       56 next unless defined $size->[ $i ];
135 16   100     49 my $fsize = $field_info{ $field }{'size'}[ $i ] || 0;
136 16 100       30 if ( $size->[ $i ] > $fsize ) {
137 11         16 $field_info{ $field }{'size'}[ $i ] = $size->[ $i ];
138             }
139             }
140              
141 14         29 $field_info{ $field }{ $type }++;
142             }
143             }
144              
145 1         57 for my $field ( keys %field_info ) {
146 7   50     16 my $size = $field_info{ $field }{'size'} || [ 1 ];
147             my $data_type =
148             $field_info{ $field }{'char'} ? 'char' :
149             $field_info{ $field }{'float'} ? 'float' :
150 7 50       24 $field_info{ $field }{'integer'} ? 'integer' : 'char';
    100          
    100          
151              
152 7 50 66     23 if ( $data_type eq 'char' && scalar @$size == 2 ) {
153 0         0 $size = [ $size->[0] + $size->[1] ];
154             }
155              
156 7         16 my $field = $table->get_field( $field );
157 7         131 $field->size( $size );
158 7         63 $field->data_type( $data_type );
159             }
160             }
161              
162 1         17 return 1;
163             }
164              
165             1;
166              
167             =pod
168              
169             =head1 AUTHORS
170              
171             Darren Chamberlain Edarren@cpan.orgE,
172             Ken Y. Clark Ekclark@cpan.orgE.
173              
174             =head1 SEE ALSO
175              
176             Text::RecordParser, SQL::Translator.
177              
178             =cut