Allow embedded comments a la the PG parser, store the comments; also strip
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / xSV.pm
CommitLineData
046f18e5 1package SQL::Translator::Parser::xSV;
2
49e1eb70 3# -------------------------------------------------------------------
f62bd16c 4# $Id: xSV.pm,v 1.10 2003-06-11 03:59:49 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);
f62bd16c 69$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\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
70944bc5 95 my $schema = $tr->schema;
9d90f9cd 96 my $table = $schema->add_table( name => 'table1' );
97
825ed07b 98 #
99 # Get the field names from the first row.
100 #
101 $parser->bind_header;
102 my @field_names = $parser->field_list;
046f18e5 103
825ed07b 104 for ( my $i = 0; $i < @field_names; $i++ ) {
9d90f9cd 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);
046f18e5 117 }
118 }
119
825ed07b 120 #
121 # If directed, look at every field's values to guess size and type.
122 #
9d90f9cd 123 unless (
124 defined $args->{'scan_fields'} &&
125 $args->{'scan_fields'} == 0
126 ) {
825ed07b 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 } : '';
2008ecf3 131 my $size = [ length $data ];
825ed07b 132 my $type;
133
134 if ( $data =~ /^-?\d+$/ ) {
135 $type = 'integer';
136 }
2008ecf3 137 elsif (
138 $data =~ /^-?[,\d]+\.[\d+]?$/
139 ||
140 $data =~ /^-?[,\d]+?\.\d+$/
141 ||
142 $data =~ /^-?\.\d+$/
143 ) {
825ed07b 144 $type = 'float';
2008ecf3 145 my ( $w, $d ) = map { s/,//g; $_ } split( /\./, $data );
146 $size = [ length $w, length $d ];
825ed07b 147 }
148 else {
149 $type = 'char';
150 }
151
2008ecf3 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 }
825ed07b 158 }
159
160 $field_info{ $field }{ $type }++;
161 }
162 }
163
164 for my $field ( keys %field_info ) {
9d90f9cd 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
9d90f9cd 170 my $field = $table->get_field( $field );
171 $field->size( $size );
172 $field->data_type( $data_type );
825ed07b 173 }
174 }
175
f62bd16c 176 return 1;
046f18e5 177}
178
046f18e5 1791;
825ed07b 180
181# -------------------------------------------------------------------
182=pod
183
184=head1 AUTHOR
185
186Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
187Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
188
189=head1 SEE ALSO
190
191Text::RecordParser.
192
193=cut