Added CSV parser and a test.
Darren Chamberlain [Mon, 25 Mar 2002 14:27:23 +0000 (14:27 +0000)]
lib/SQL/Translator/Parser/xSV.pm [new file with mode: 0644]
t/05bgep-re.t
t/06xsv.t [new file with mode: 0644]

diff --git a/lib/SQL/Translator/Parser/xSV.pm b/lib/SQL/Translator/Parser/xSV.pm
new file mode 100644 (file)
index 0000000..b77e015
--- /dev/null
@@ -0,0 +1,84 @@
+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__
index 495be5f..a7b9f13 100644 (file)
@@ -2,7 +2,7 @@
 # vim: set ft=perl:
 #
 
-#BEGIN { print "0..0\n"; }
+BEGIN { print "1..1\n"; }
 
 use strict;
 use Data::Dumper;
diff --git a/t/06xsv.t b/t/06xsv.t
new file mode 100644 (file)
index 0000000..af5d109
--- /dev/null
+++ b/t/06xsv.t
@@ -0,0 +1,64 @@
+#!/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";