Changed grammar to bring it more inline with the official MySQL YACC
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / xSV.pm
1 package SQL::Translator::Parser::xSV;
2
3 # -------------------------------------------------------------------
4 # $Id: xSV.pm,v 1.8 2003-05-09 19:51:04 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 #                    darren chamberlain <darren@cpan.org>
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
24 =head1 NAME
25
26 SQL::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
40 Parses arbitrarily delimited text files.  See the 
41 Text::RecordParser manpage for arguments on how to parse the file
42 (e.g., C<field_separator>, C<record_separator>).  Other arguments
43 include:
44
45 =over
46
47 =item * scan_fields
48
49 Indicates that the columns should be scanned to determine data types
50 and field sizes.  True by default.
51
52 =item * trim_fields
53
54 A shortcut to sending filters to Text::RecordParser, will create 
55 callbacks that trim leading and trailing spaces from fields and headers.
56 True by default.
57
58 =back
59
60 Field names will automatically be normalized by 
61 C<SQL::Translator::Utils::normalize>.
62
63 =cut
64
65 # -------------------------------------------------------------------
66
67 use strict;
68 use vars qw($VERSION @EXPORT);
69 $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
70
71 use Exporter;
72 use Text::ParseWords qw(quotewords);
73 use Text::RecordParser;
74 use SQL::Translator::Utils qw(debug normalize_name);
75
76 use base qw(Exporter);
77 @EXPORT = qw(parse);
78
79 #
80 # Passed a SQL::Translator instance and a string containing the data
81 #
82 sub parse {
83     my ( $tr, $data )    = @_;
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; $_ } ) 
93         unless defined $args->{'trim_fields'} && $args->{'trim_fields'} == 0;
94
95     #
96     # Create skeleton structure, mostly empty.
97     #
98     my $parsed      =  {
99         table1      => {
100             type    => undef,
101             indices => [ { } ],
102             fields  => { },
103         },
104     };
105
106     my $schema = $tr->schema;
107     my $table = $schema->add_table( name => 'table1' );
108
109     #
110     # Get the field names from the first row.
111     #
112     $parser->bind_header;
113     my @field_names = $parser->field_list;
114
115     for ( my $i = 0; $i < @field_names; $i++ ) {
116         $parsed->{'table1'}{'fields'}{ $field_names[$i] } = {
117             type           => 'field',
118             order          => $i,
119             name           => $field_names[$i],
120
121             # Default datatype is "char"
122             data_type      => 'char',
123
124             # default size is 8bits; something more reasonable?
125             size           => [ 255 ],
126             null           => 1,
127             default        => '',
128             is_auto_inc    => undef,
129
130             # field field is the primary key
131             is_primary_key => ($i == 0) ? 1 : undef,
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);
146         }
147     }
148
149     #
150     # If directed, look at every field's values to guess size and type.
151     #
152     unless ( 
153         defined $args->{'scan_fields'} &&
154         $args->{'scan_fields'} == 0
155     ) {
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                 }
166                 elsif ( $data =~ /^-?[\d.]+$/ ) {
167                     $type = 'float';
168                 }
169                 else {
170                     $type = 'char';
171                 }
172
173                 my $fsize = $field_info{ $field }{'size'} || 0;
174                 if ( $size > $fsize ) {
175                     $field_info{ $field }{'size'} = $size;
176                 }
177
178                 $field_info{ $field }{ $type }++;
179             }
180         }
181
182         for my $field ( keys %field_info ) {
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
188             $parsed->{'table1'}{'fields'}{ $field }{'size'} = 
189                 [ $field_info{ $field }{'size'} ];
190
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 );
196         }
197     }
198
199     #
200     # Field 0 is primary key, by default, so add an index
201     #
202     for ( $parsed->{'table1'}->{'indices'}->[0] ) {
203         $_->{'type'}   = 'primary_key';
204         $_->{'name'}   = undef;
205         $_->{'fields'} = [ $field_names[0] ];
206     }
207
208     return $parsed;
209 }
210
211 1;
212
213 # -------------------------------------------------------------------
214 =pod
215
216 =head1 AUTHOR
217
218 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
219 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
220
221 =head1 SEE ALSO
222
223 Text::RecordParser.
224
225 =cut