Allow embedded comments a la the PG parser, store the comments; also strip
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / xSV.pm
1 package SQL::Translator::Parser::xSV;
2
3 # -------------------------------------------------------------------
4 # $Id: xSV.pm,v 1.10 2003-06-11 03:59:49 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.10 $ =~ /(\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     my $schema = $tr->schema;
96     my $table = $schema->add_table( name => 'table1' );
97
98     #
99     # Get the field names from the first row.
100     #
101     $parser->bind_header;
102     my @field_names = $parser->field_list;
103
104     for ( my $i = 0; $i < @field_names; $i++ ) {
105         my $field = $table->add_field(
106             name              => $field_names[$i],
107             data_type         => 'char',
108             default_value     => '',
109             size              => 255,
110             is_nullable       => 1,
111             is_auto_increment => undef,
112         ) or die $table->error;
113
114         if ( $i == 0 ) {
115             $table->primary_key( $field->name );
116             $field->is_primary_key(1);
117         }
118     }
119
120     #
121     # If directed, look at every field's values to guess size and type.
122     #
123     unless ( 
124         defined $args->{'scan_fields'} &&
125         $args->{'scan_fields'} == 0
126     ) {
127         my %field_info = map { $_, {} } @field_names;
128         while ( my $rec = $parser->fetchrow_hashref ) {
129             for my $field ( @field_names ) {
130                 my $data = defined $rec->{ $field } ? $rec->{ $field } : '';
131                 my $size = [ length $data ];
132                 my $type;
133
134                 if ( $data =~ /^-?\d+$/ ) {
135                     $type = 'integer';
136                 }
137                 elsif ( 
138                     $data =~ /^-?[,\d]+\.[\d+]?$/ 
139                     ||
140                     $data =~ /^-?[,\d]+?\.\d+$/  
141                     ||
142                     $data =~ /^-?\.\d+$/  
143                 ) {
144                     $type = 'float';
145                     my ( $w, $d ) = map { s/,//g; $_ } split( /\./, $data );
146                     $size = [ length $w, length $d ];
147                 }
148                 else {
149                     $type = 'char';
150                 }
151
152                 for my $i ( 0, 1 ) {
153                     next unless defined $size->[ $i ];
154                     my $fsize = $field_info{ $field }{'size'}[ $i ] || 0;
155                     if ( $size->[ $i ] > $fsize ) {
156                         $field_info{ $field }{'size'}[ $i ] = $size->[ $i ];
157                     }
158                 }
159
160                 $field_info{ $field }{ $type }++;
161             }
162         }
163
164         for my $field ( keys %field_info ) {
165             my $size      = $field_info{ $field }{'size'};
166             my $data_type = 
167                 $field_info{ $field }{'char'}  ? 'char'  : 
168                 $field_info{ $field }{'float'} ? 'float' : 'integer';
169
170             my $field = $table->get_field( $field );
171             $field->size( $size );
172             $field->data_type( $data_type );
173         }
174     }
175
176     return 1;
177 }
178
179 1;
180
181 # -------------------------------------------------------------------
182 =pod
183
184 =head1 AUTHOR
185
186 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
187 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
188
189 =head1 SEE ALSO
190
191 Text::RecordParser.
192
193 =cut