Added rules to catch common (but useless) statements.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / xSV.pm
CommitLineData
046f18e5 1package SQL::Translator::Parser::xSV;
2
49e1eb70 3# -------------------------------------------------------------------
70944bc5 4# $Id: xSV.pm,v 1.8 2003-05-09 19:51:04 kycl4rk Exp $
49e1eb70 5# -------------------------------------------------------------------
abfa405a 6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
825ed07b 7# darren chamberlain <darren@cpan.org>
046f18e5 8#
9# This program is free software; you can redistribute it and/or
10# modify it under the terms of the GNU General Public License as
11# published by the Free Software Foundation; version 2.
12#
13# This program is distributed in the hope that it will be useful, but
14# WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16# General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program; if not, write to the Free Software
20# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21# 02111-1307 USA
22# -------------------------------------------------------------------
23
825ed07b 24=head1 NAME
25
26SQL::Translator::Parser::xSV - parser for arbitrarily delimited text files
27
28=head1 SYNOPSIS
29
30 use SQL::Translator;
31 use SQL::Translator::Parser::xSV;
32
33 my $translator = SQL::Translator->new(
34 parser => 'xSV',
35 parser_args => { field_separator => "\t" },
36 );
37
38=head1 DESCRIPTION
39
40Parses arbitrarily delimited text files. See the
41Text::RecordParser manpage for arguments on how to parse the file
42(e.g., C<field_separator>, C<record_separator>). Other arguments
43include:
44
45=over
46
47=item * scan_fields
48
49Indicates that the columns should be scanned to determine data types
9d90f9cd 50and field sizes. True by default.
825ed07b 51
52=item * trim_fields
53
54A shortcut to sending filters to Text::RecordParser, will create
55callbacks that trim leading and trailing spaces from fields and headers.
9d90f9cd 56True by default.
825ed07b 57
58=back
59
60Field names will automatically be normalized by
61C<SQL::Translator::Utils::normalize>.
62
63=cut
64
65# -------------------------------------------------------------------
66
046f18e5 67use strict;
68use vars qw($VERSION @EXPORT);
70944bc5 69$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
046f18e5 70
71use Exporter;
72use Text::ParseWords qw(quotewords);
825ed07b 73use Text::RecordParser;
74use SQL::Translator::Utils qw(debug normalize_name);
046f18e5 75
76use base qw(Exporter);
77@EXPORT = qw(parse);
78
825ed07b 79#
046f18e5 80# Passed a SQL::Translator instance and a string containing the data
825ed07b 81#
046f18e5 82sub parse {
70944bc5 83 my ( $tr, $data ) = @_;
825ed07b 84 my $args = $tr->parser_args;
85 my $parser = Text::RecordParser->new(
86 field_separator => $args->{'field_separator'} || ',',
87 record_separator => $args->{'record_separator'} || "\n",
88 data => $data,
89 header_filter => \&normalize_name,
90 );
91
92 $parser->field_filter( sub { $_ = shift; s/^\s+|\s+$//g; $_ } )
9d90f9cd 93 unless defined $args->{'trim_fields'} && $args->{'trim_fields'} == 0;
825ed07b 94
95 #
96 # Create skeleton structure, mostly empty.
97 #
98 my $parsed = {
99 table1 => {
100 type => undef,
101 indices => [ { } ],
102 fields => { },
046f18e5 103 },
104 };
105
70944bc5 106 my $schema = $tr->schema;
9d90f9cd 107 my $table = $schema->add_table( name => 'table1' );
108
825ed07b 109 #
110 # Get the field names from the first row.
111 #
112 $parser->bind_header;
113 my @field_names = $parser->field_list;
046f18e5 114
825ed07b 115 for ( my $i = 0; $i < @field_names; $i++ ) {
116 $parsed->{'table1'}{'fields'}{ $field_names[$i] } = {
117 type => 'field',
046f18e5 118 order => $i,
825ed07b 119 name => $field_names[$i],
046f18e5 120
121 # Default datatype is "char"
9d90f9cd 122 data_type => 'char',
046f18e5 123
124 # default size is 8bits; something more reasonable?
ab0aa010 125 size => [ 255 ],
046f18e5 126 null => 1,
825ed07b 127 default => '',
046f18e5 128 is_auto_inc => undef,
129
130 # field field is the primary key
131 is_primary_key => ($i == 0) ? 1 : undef,
9d90f9cd 132 };
133
134 my $field = $table->add_field(
135 name => $field_names[$i],
136 data_type => 'char',
137 default_value => '',
138 size => 255,
139 is_nullable => 1,
140 is_auto_increment => undef,
141 ) or die $table->error;
142
143 if ( $i == 0 ) {
144 $table->primary_key( $field->name );
145 $field->is_primary_key(1);
046f18e5 146 }
147 }
148
825ed07b 149 #
150 # If directed, look at every field's values to guess size and type.
151 #
9d90f9cd 152 unless (
153 defined $args->{'scan_fields'} &&
154 $args->{'scan_fields'} == 0
155 ) {
825ed07b 156 my %field_info = map { $_, {} } @field_names;
157 while ( my $rec = $parser->fetchrow_hashref ) {
158 for my $field ( @field_names ) {
159 my $data = defined $rec->{ $field } ? $rec->{ $field } : '';
160 my $size = length $data;
161 my $type;
162
163 if ( $data =~ /^-?\d+$/ ) {
164 $type = 'integer';
165 }
9d90f9cd 166 elsif ( $data =~ /^-?[\d.]+$/ ) {
825ed07b 167 $type = 'float';
168 }
169 else {
170 $type = 'char';
171 }
172
9d90f9cd 173 my $fsize = $field_info{ $field }{'size'} || 0;
174 if ( $size > $fsize ) {
825ed07b 175 $field_info{ $field }{'size'} = $size;
176 }
177
178 $field_info{ $field }{ $type }++;
179 }
180 }
181
182 for my $field ( keys %field_info ) {
9d90f9cd 183 my $size = $field_info{ $field }{'size'};
184 my $data_type =
185 $field_info{ $field }{'char'} ? 'char' :
186 $field_info{ $field }{'float'} ? 'float' : 'integer';
187
825ed07b 188 $parsed->{'table1'}{'fields'}{ $field }{'size'} =
189 [ $field_info{ $field }{'size'} ];
190
9d90f9cd 191 $parsed->{'table1'}{'fields'}{ $field }{'data_type'} = $data_type;
192
193 my $field = $table->get_field( $field );
194 $field->size( $size );
195 $field->data_type( $data_type );
825ed07b 196 }
197 }
198
199 #
046f18e5 200 # Field 0 is primary key, by default, so add an index
825ed07b 201 #
202 for ( $parsed->{'table1'}->{'indices'}->[0] ) {
203 $_->{'type'} = 'primary_key';
204 $_->{'name'} = undef;
205 $_->{'fields'} = [ $field_names[0] ];
046f18e5 206 }
207
208 return $parsed;
209}
210
046f18e5 2111;
825ed07b 212
213# -------------------------------------------------------------------
214=pod
215
216=head1 AUTHOR
217
218Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
219Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
220
221=head1 SEE ALSO
222
223Text::RecordParser.
224
225=cut