--- /dev/null
+package SQL::Translator::Parser::xSV;
+
+#-----------------------------------------------------
+# $Id: xSV.pm,v 1.1 2002-03-25 14:27:23 dlc Exp $
+#-----------------------------------------------------
+# Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
+# darren chamberlain <darren@cpan.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; version 2.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+# 02111-1307 USA
+# -------------------------------------------------------------------
+
+use strict;
+use vars qw($VERSION @EXPORT);
+$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+
+use Exporter;
+use Text::ParseWords qw(quotewords);
+
+use base qw(Exporter);
+@EXPORT = qw(parse);
+
+# Passed a SQL::Translator instance and a string containing the data
+sub parse {
+ my ($tr, $data) = @_;
+
+ # Skeleton structure, mostly empty
+ my $parsed = {
+ table1 => {
+ "type" => undef,
+ "indeces" => [ { } ],
+ "fields" => { },
+ },
+ };
+
+ # Discard all but the first line
+ $data = (split m,$/,, $data)[0];
+
+ my @parsed = quotewords(',\s*', 0, $data);
+
+ for (my $i = 0; $i < @parsed; $i++) {
+ $parsed->{"table1"}->{"fields"}->{$parsed[$i]} = {
+ type => "field",
+ order => $i,
+ name => $parsed[$i],
+
+ # Default datatype is "char"
+ data_type => "char",
+
+ # default size is 8bits; something more reasonable?
+ size => 255,
+ null => 1,
+ default => "",
+ is_auto_inc => undef,
+
+ # field field is the primary key
+ is_primary_key => ($i == 0) ? 1 : undef,
+ }
+ }
+
+ # Field 0 is primary key, by default, so add an index
+ for ($parsed->{"table1"}->{"indeces"}->[0]) {
+ $_->{"type"} = "primary_key";
+ $_->{"name"} = undef;
+ $_->{"fields"} = [ $parsed[0] ];
+ }
+
+ return $parsed;
+}
+
+
+1;
+__END__
# vim: set ft=perl:
#
-#BEGIN { print "0..0\n"; }
+BEGIN { print "1..1\n"; }
use strict;
use Data::Dumper;
--- /dev/null
+#!/usr/bin/perl
+# vim: set ft=perl:
+#
+#
+
+use strict;
+use SQL::Translator;
+use SQL::Translator::Parser::xSV qw(parse);
+
+$SQL::Translator::DEBUG = 0;
+
+my $tr = SQL::Translator->new;
+my $data = q|One, Two, Three, Four, Five
+I, Am, Some, Data, Yo
+And, So, am, I, "you crazy, crazy bastard"
+);|;
+
+BEGIN { print "1..10\n"; }
+
+my $val = parse($tr, $data);
+
+# $val holds the processed data structure.
+
+# The data structure should have one key:
+print "not " if (scalar keys %{$val} != 1);
+print "ok 1\n";
+
+# The data structure should have a single key, named sessions
+print "not " unless (defined $val->{'table1'});
+print qq(ok 2 # has a key named "table1"\n);
+
+# $val->{'table1'} should have a single index (since we haven't
+# defined an index, but have defined a primary key)
+my $indeces = $val->{'table1'}->{'indeces'};
+print "not " unless (scalar @{$indeces} == 1);
+print "ok 3 # correct index number\n";
+
+print "not " unless ($indeces->[0]->{'type'} eq 'primary_key');
+print "ok 4 # correct index type\n";
+print "not " unless ($indeces->[0]->{'fields'}->[0] eq 'One');
+print "ok 5 # correct index name\n";
+
+# $val->{'table1'} should have two fields, id and a_sessionn
+my $fields = $val->{'table1'}->{'fields'};
+print "not " unless (scalar keys %{$fields} == 5);
+print "ok 6 # correct number of fields (5)\n";
+
+print "not " unless ($fields->{'One'}->{'data_type'} eq 'char');
+print "ok 7 # correct field type: One (char)\n";
+
+print "not " unless ($fields->{'One'}->{'is_primary_key'} == 1);
+print "ok 8 # correct key identification (One == key)\n";
+
+print "not " if (defined $fields->{'Two'}->{'is_primary_key'});
+print "ok 9 # correct key identification (Two != key)\n";
+
+# Test that the order is being maintained by the internal order
+# data element
+my @order = sort { $fields->{$a}->{'order'}
+ <=>
+ $fields->{$b}->{'order'}
+ } keys %{$fields};
+print "not " unless ($order[0] eq 'One' && $order[4] eq 'Five');
+print "ok 10 # ordering of fields\n";