Skip to content

Commit b31dda6

Browse files
author
H.Merijn Brand - Tux
committed
Make csv_ & f_ aliasses more consistently available (issue #7)
Now with tests
1 parent c48e59d commit b31dda6

File tree

9 files changed

+192
-72
lines changed

9 files changed

+192
-72
lines changed

‎ChangeLog

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
1-
0.55 - 2020-07-25, H.Merijn Brand
1+
0.55 - 2020-07-27, H.Merijn Brand
22
* Free unref scalar test fixed in Text::CSV_XS 1.35
33
* It's 2019
44
* Provide cpanfile
55
* Doc enhancements
66
* It's 2020
7-
* Make csv_ aliasses more consistently available (issue #7)
7+
* Make csv_ & f_ aliasses more consistently available (issue #7)
88

99
0.53 - 2018-05-20, H.Merijn Brand
1010
* No folder scanning during automated tests

‎MANIFEST

+2
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@ lib/Bundle/DBD/CSV.pm
88
lib/DBD/CSV.pm
99
lib/DBD/CSV/TypeInfo.pm
1010
lib/DBD/CSV/GetInfo.pm
11+
files/fruit.csv
12+
files/tools.csv
1113
t/10_base.t
1214
t/11_dsnlist.t
1315
t/20_createdrop.t

‎files/fruit.csv

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
c_fruit,fruit
2+
1,Apple
3+
2,Blueberry
4+
3,Orange
5+
4,Melon

‎files/tools.csv

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
c_tool;tool
2+
1;Hammer
3+
2;Screwdriver
4+
3;Drill
5+
4;Saw
6+
5;Router
7+
6;Hobbyknife

‎lib/DBD/CSV.pm

+26-28
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,14 @@ require DynaLoader;
1515
require DBD::File;
1616
require IO::File;
1717

18+
our @f_SHORT = qw( file dir dir_search ext lock lockfile schema encoding );
19+
our @c_SHORT = qw( class eof
20+
eol sep_char quote_char escape_char binary decode_utf8 auto_diag
21+
diag_verbose blank_is_undef empty_is_undef allow_whitespace
22+
allow_loose_quotes allow_loose_escapes allow_unquoted_escape
23+
always_quote quote_empty quote_space escape_null quote_binary
24+
keep_meta_info callbacks );
25+
1826
package DBD::CSV;
1927

2028
use strict;
@@ -23,7 +31,7 @@ use vars qw( @ISA $VERSION $ATTRIBUTION $drh $err $errstr $sqlstate );
2331

2432
@ISA = qw( DBD::File );
2533

26-
$VERSION = "0.54";
34+
$VERSION = "0.55";
2735
$ATTRIBUTION = "DBD::CSV $DBD::CSV::VERSION by H.Merijn Brand";
2836

2937
$err = 0; # holds error code for DBI::err
@@ -68,6 +76,20 @@ our $data_sources_attr = undef;
6876

6977
sub connect {
7078
my ($drh, $dbname, $user, $auth, $attr) = @_;
79+
if ($attr && ref $attr eq "HASH") {
80+
# Top-level aliasses
81+
foreach my $key (grep { exists $attr->{$_} } @f_SHORT) {
82+
my $f_key = "f_$key";
83+
exists $attr->{$f_key} and next;
84+
$attr->{$f_key} = delete $attr->{$key};
85+
}
86+
foreach my $key (grep { exists $attr->{$_} } @c_SHORT) {
87+
my $c_key = "csv_$key";
88+
exists $attr->{$c_key} and next;
89+
$attr->{$c_key} = delete $attr->{$key};
90+
}
91+
}
92+
7193
my $dbh = $drh->DBD::File::dr::connect ($dbname, $user, $auth, $attr);
7294
$dbh and $dbh->{Active} = 1;
7395
$dbh;
@@ -94,31 +116,7 @@ sub init_valid_attributes {
94116
my $dbh = shift;
95117

96118
# Straight from Text::CSV_XS.pm
97-
my @xs_attr = qw(
98-
eol
99-
sep_char
100-
quote_char
101-
escape_char
102-
binary
103-
decode_utf8
104-
auto_diag
105-
diag_verbose
106-
blank_is_undef
107-
empty_is_undef
108-
allow_whitespace
109-
allow_loose_quotes
110-
allow_loose_escapes
111-
allow_unquoted_escape
112-
always_quote
113-
quote_empty
114-
quote_space
115-
escape_null
116-
quote_binary
117-
keep_meta_info
118-
verbatim
119-
types
120-
callbacks
121-
);
119+
my @xs_attr = @c_SHORT;
122120
@csv_xs_attr{@xs_attr} = ();
123121
# Dynamically add "new" attributes - available in Text::CSV_XS-1.20
124122
if (my @ka = eval { Text::CSV_XS->known_attributes }) {
@@ -207,8 +205,8 @@ my %compat_map;
207205

208206
my $x = 0;
209207
if (!%compat_map) {
210-
$compat_map{$_} = "f_$_" for qw( file ext dir lock lockfile );
211-
$compat_map{$_} = "csv_$_" for qw( class eof eol quote_char sep_char escape_char );
208+
$compat_map{$_} = "f_$_" for @f_SHORT;
209+
$compat_map{$_} = "csv_$_" for @c_SHORT;
212210
$x++;
213211
}
214212
if ($class and !$class_mapped{$class}++ and

‎sandbox/issue-7/files

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
.

‎sandbox/issue-7/issue-7.pl

100644100755
+85-41
Original file line numberDiff line numberDiff line change
@@ -1,49 +1,93 @@
1-
#!/usr/bin/perl
1+
#!/pro/bin/perl
22

33
use 5.18.2;
44
use warnings;
55

6-
use DP;
6+
our $VERSION = "0.02 - 20200727";
7+
our $CMD = $0 =~ s{.*/}{}r;
8+
9+
sub usage {
10+
my $err = shift and select STDERR;
11+
say "usage: $CMD [--devel]";
12+
exit $err;
13+
} # usage
14+
15+
use CSV;
716
use DBI;
8-
use lib "/pro/3gl/CPAN/DBD-CSV/lib";
9-
use lib "/pro/3gl/CPAN/DBD-CSV/blib/arch";
10-
use lib "/pro/3gl/CPAN/DBD-CSV/blib/lib";
11-
12-
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
13-
f_schema => undef,
14-
f_dir => ".",
15-
f_ext => ".csv/r",
16-
17-
RaiseError => 1,
18-
PrintError => 1,
19-
}) or die "$DBI::errstr\n" || $DBI::errstr;
20-
21-
$dbh->{csv_tables}{tst} = {
22-
file => "test.csv", # alias to f_file
23-
eol => "\n", # alias to csv_eol
24-
sep_char => ";", # alias to csv_sep_char
25-
always_quote => 1, # alias to csv_always_quote
26-
col_names => [qw( c_tst s_tst )],
27-
};
28-
29-
#$dbh->{TraceLevel} = 99;
30-
31-
say for $dbh->tables (undef, undef, undef, undef);
32-
33-
$dbh->{csv_tables}{tools}{sep_char} = ";"; # should work
34-
35-
foreach my $t (qw( tools fruit )) {
36-
say $t;
37-
my $sth = $dbh->prepare ("select * from $t");
38-
$sth->execute;
39-
while (my @r = $sth->fetchrow_array) {
40-
printf "%4d %s\n", @r;
41-
}
17+
use Test::More;
18+
use Getopt::Long qw(:config bundling);
19+
GetOptions (
20+
"help|?" => sub { usage (0); },
21+
"V|version" => sub { say "$CMD [$VERSION]"; exit 0; },
22+
23+
"d|devel!" => \ my $opt_d,
24+
25+
"v|verbose:1" => \(my $opt_v = 0),
26+
) or usage (1);
27+
28+
if ($opt_d) {
29+
unshift @INC => "/pro/3gl/CPAN/DBD-CSV/lib";
30+
unshift @INC => "/pro/3gl/CPAN/DBD-CSV/blib/arch";
31+
unshift @INC => "/pro/3gl/CPAN/DBD-CSV/blib/lib";
4232
}
4333

44-
open my $fh, ">", "test.csv";close $fh;
45-
# If empty should insert "c_tst";"s_tst"
46-
$dbh->do ("insert into tst values (42, 'Test')"); # "42";"Test"
47-
$dbh->do ("update tst set s_tst = 'Done' where c_tst = 42"); # "42";"Done"
34+
foreach my $x (0, 1) {
35+
my ($fpfx, $cpfx) = $x ? ("f_", "csv_") : ("", "");
36+
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
37+
"${fpfx}schema" => undef,
38+
"${fpfx}dir" => "files",
39+
"${fpfx}ext" => ".csv/r",
40+
41+
"${cpfx}eol" => "\n", # alias to csv_eol
42+
"${cpfx}always_quote" => 1, # alias to csv_always_quote
43+
"${cpfx}sep_char" => ";", # alias to csv_sep_char
44+
45+
RaiseError => 1,
46+
PrintError => 1,
47+
}) or die "$DBI::errstr\n" || $DBI::errstr;
48+
49+
unlink "test.csv";
50+
$dbh->{csv_tables}{tst} = {
51+
file => "test.csv", # alias to f_file
52+
col_names => [qw( c_tst s_tst )],
53+
};
54+
55+
is_deeply (
56+
[ sort $dbh->tables (undef, undef, undef, undef) ],
57+
[qw( fruit tools )], "Tables");
58+
is_deeply (
59+
[ sort keys %{$dbh->{csv_tables}} ],
60+
[qw( fruit tools tst )], "Mixed tables");
61+
62+
$dbh->{csv_tables}{fruit}{sep_char} = ","; # should work
63+
64+
is_deeply ($dbh->selectall_arrayref ("select * from tools order by c_tool"),
65+
[ [ 1, "Hammer" ],
66+
[ 2, "Screwdriver" ],
67+
[ 3, "Drill" ],
68+
[ 4, "Saw" ],
69+
[ 5, "Router" ],
70+
[ 6, "Hobbyknife" ],
71+
], "Sorted tools");
72+
is_deeply ($dbh->selectall_arrayref ("select * from fruit order by c_fruit"),
73+
[ [ 1, "Apple" ],
74+
[ 2, "Blueberry" ],
75+
[ 3, "Orange" ],
76+
[ 4, "Melon" ],
77+
], "Sorted fruit");
78+
79+
open my $fh, ">", "test.csv";close $fh;
80+
# If empty should insert "c_tst";"s_tst"
81+
$dbh->do ("insert into tst values (42, 'Test')"); # "42";"Test"
82+
$dbh->do ("update tst set s_tst = 'Done' where c_tst = 42"); # "42";"Done"
83+
84+
$dbh->disconnect;
85+
86+
open $fh, "<", "test.csv" or die "test.csv: $!\n";
87+
my @dta = <$fh>;
88+
close $fh;
89+
is ($dta[-1], qq{"42";"Done"\n}, "Table tst written to test.csv");
90+
unlink "test.csv";
91+
}
4892

49-
$dbh->disconnect;
93+
done_testing;

‎sandbox/issue-7/test.csv

-1
This file was deleted.

‎t/61_meta.t

+64
Original file line numberDiff line numberDiff line change
@@ -124,6 +124,70 @@ note ("File name - with col_names");
124124

125125
unlink $fn;
126126

127+
note ("Attribute prefixes");
128+
$fn = "test.csv";
129+
foreach my $x (0, 1) {
130+
my ($fpfx, $cpfx) = $x ? ("f_", "csv_") : ("", "");
131+
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
132+
"${fpfx}schema" => undef, # schema / f_schema
133+
"${fpfx}dir" => "files", # .. f_dir
134+
"${fpfx}ext" => ".csv/r", # .. f_ext
135+
136+
"${cpfx}eol" => "\n", # eol / csv_eol
137+
"${cpfx}always_quote" => 1, # .. csv_always_quote
138+
"${cpfx}sep_char" => ";", # .. csv_sep_char
139+
140+
RaiseError => 1,
141+
PrintError => 1,
142+
}) or die "$DBI::errstr\n" || $DBI::errstr;
143+
144+
my $ffn = "files/$fn";
145+
unlink $ffn;
146+
$dbh->{csv_tables}{tst} = {
147+
"${fpfx}file" => $fn, # file / f_file
148+
col_names => [qw( c_tst s_tst )],
149+
};
150+
151+
is_deeply (
152+
[ sort $dbh->tables (undef, undef, undef, undef) ],
153+
[qw( fruit tools )], "Tables");
154+
is_deeply (
155+
[ sort keys %{$dbh->{csv_tables}} ],
156+
[qw( fruit tools tst )], "Mixed tables");
157+
158+
$dbh->{csv_tables}{fruit}{sep_char} = ","; # should work
159+
160+
is_deeply ($dbh->selectall_arrayref ("select * from tools order by c_tool"),
161+
[ [ 1, "Hammer" ],
162+
[ 2, "Screwdriver" ],
163+
[ 3, "Drill" ],
164+
[ 4, "Saw" ],
165+
[ 5, "Router" ],
166+
[ 6, "Hobbyknife" ],
167+
], "Sorted tools");
168+
is_deeply ($dbh->selectall_arrayref ("select * from fruit order by c_fruit"),
169+
[ [ 1, "Apple" ],
170+
[ 2, "Blueberry" ],
171+
[ 3, "Orange" ],
172+
[ 4, "Melon" ],
173+
], "Sorted fruit");
174+
175+
# TODO: Ideally, insert should create the file if empty or non-existent
176+
# and insert "c_tst";"s_tst" as header line
177+
open my $fh, ">", $ffn; close $fh;
178+
179+
$dbh->do ("insert into tst values (42, 'Test')"); # "42";"Test"
180+
$dbh->do ("update tst set s_tst = 'Done' where c_tst = 42"); # "42";"Done"
181+
182+
$dbh->disconnect;
183+
184+
open $fh, "<", $ffn or die "$ffn: $!\n";
185+
my @dta = <$fh>;
186+
close $fh;
187+
is ($dta[-1], qq{"42";"Done"\n}, "Table tst written to $fn");
188+
unlink $ffn;
189+
}
190+
127191
done_testing ();
128192

129193
__END__

0 commit comments

Comments
 (0)