├── CSV.rakumod ├── Text-CSV.pod ├── files ├── utf8.csv ├── gitignore └── fez.gitignore ├── p6 ├── NLPW-2015 ├── .exrc ├── 060-ref.txt ├── 015-irc.txt ├── 072-init.txt ├── 071-defaults.txt ├── 020-bugs.txt ├── 023-bugs.txt ├── 010-rakudo.txt ├── 021-bugs.txt ├── 073-check.txt ├── 022-bugs.txt ├── 070-types.txt ├── 035-chunks.txt ├── 018-debug.txt ├── 001-cope.txt ├── 074-build.txt ├── 032-grammar.txt ├── 081-errors.txt ├── 005-slang.txt ├── 111-multi.txt ├── 050-meta.txt ├── 030-state.txt ├── 110-multi.txt ├── 080-errors.txt ├── index ├── 040-test.txt ├── 051-meta.txt ├── 090-hooks.txt └── 041-speed.txt ├── crnl.csv ├── csv-rust-libcsv ├── csv-rust-csvrdr ├── prove6 ├── csv-rust-qckrdr ├── doc └── Text-CSV.pdf ├── logotype └── logo_32x32.png ├── test.tsv ├── .exrc ├── csv-ruby.rb ├── .whitesource ├── csv-R.R ├── csv-python2.py ├── csv-python3.py ├── sandbox ├── issue-34.csv ├── issue-32.raku ├── issue-34.raku ├── issue-34.pl ├── issue-3.raku └── issue-32.csv ├── t ├── 99_meta.t ├── 92_csv_encoding.t ├── 81_subclass.t ├── 82_subclass.t ├── 21_combine.t ├── 32_getline.t ├── 22_print.t ├── 60_samples.t ├── 31_row.t ├── 47_comment.t ├── 40_misc.t ├── 16_methods.t ├── 41_null.t ├── 75_hashref.t ├── 30_field.t ├── 55_combi.t ├── 85_util.t ├── 50_utf8.t ├── 91_csv_cb.t ├── 77_getall.t ├── 46_eol_si.t ├── 66_formula.t ├── 10_base.t ├── 78_fragment.t ├── 20_file.t ├── 67_emptrow.t ├── 80_diag.t └── 79_callbacks.t ├── csv-pegex.pl ├── csv-julia.jl ├── csv-easy-pp.pl ├── csv-easy-xs.pl ├── pj-epp.pl ├── csv-pi-easy-pp.pl ├── rust-csvreader ├── Cargo.toml ├── src │ └── csvreader.rs └── Cargo.lock ├── dbi5.pl ├── rust-libcsv ├── Cargo.toml ├── Cargo.lock └── src │ └── main.rs ├── rust-quick-reader ├── Cargo.toml ├── src │ └── quick-reader.rs └── Cargo.lock ├── csv-php.php ├── csv-ip5xs.pl ├── csv-test-pp.pl ├── csv-test-xs.pl ├── csv-test-pp-pi.pl ├── dbi6.pl ├── reasons.txt ├── csv-ip5xsio.pl ├── csv-go.go ├── csv-parser.pl ├── .github └── workflows │ └── test.yaml ├── examples ├── rewrite-tuxic.pl ├── rewrite.pl ├── speed-tuxic.pl ├── speed.pl ├── csv-check-tuxic └── csv-check ├── csv-ip5pp.pl ├── csvJava.java ├── csv-xsbc.pl ├── csv-lua.lua ├── .gitignore ├── .aspell.local.pws ├── test.sh ├── test-tuxic.pl ├── csv-c.c ├── make-dist ├── META6.json ├── csv-cc.cc ├── Notes ├── test-t.pl ├── CONTRIBUTING.md ├── time-twice.pl ├── lib └── Text │ └── IO │ └── String.rakumod ├── README.md ├── TODO ├── nc-c.pl ├── Makefile ├── csv_gram.pl ├── README.speed ├── csv.pl ├── test.pl └── LICENSE /CSV.rakumod: -------------------------------------------------------------------------------- 1 | lib/Text/CSV.rakumod -------------------------------------------------------------------------------- /Text-CSV.pod: -------------------------------------------------------------------------------- 1 | lib/Text/CSV.pod6 -------------------------------------------------------------------------------- /files/utf8.csv: -------------------------------------------------------------------------------- 1 | "Øl/Vin",0 2 | -------------------------------------------------------------------------------- /p6: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | exec raku -Ilib "$@" 3 | -------------------------------------------------------------------------------- /NLPW-2015/.exrc: -------------------------------------------------------------------------------- 1 | set! font="DejaVu Sans Mono*18" 2 | -------------------------------------------------------------------------------- /crnl.csv: -------------------------------------------------------------------------------- 1 | 1,2,,"4","5 with \r\n 2 | embedded",6 3 | -------------------------------------------------------------------------------- /csv-rust-libcsv: -------------------------------------------------------------------------------- 1 | rust-libcsv/target/release/csvreader -------------------------------------------------------------------------------- /csv-rust-csvrdr: -------------------------------------------------------------------------------- 1 | rust-csvreader/target/release/csvreader -------------------------------------------------------------------------------- /prove6: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | exec prove -e 'raku -I. -Ilib' $@ 3 | -------------------------------------------------------------------------------- /csv-rust-qckrdr: -------------------------------------------------------------------------------- 1 | rust-quick-reader/target/release/quick-reader -------------------------------------------------------------------------------- /doc/Text-CSV.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tux/CSV/master/doc/Text-CSV.pdf -------------------------------------------------------------------------------- /logotype/logo_32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tux/CSV/master/logotype/logo_32x32.png -------------------------------------------------------------------------------- /test.tsv: -------------------------------------------------------------------------------- 1 | c_species species legs 2 | 1 cat 4 3 | 2 caterpillar 6 4 | 3 spider 8 5 | 4 human 2 6 | -------------------------------------------------------------------------------- /.exrc: -------------------------------------------------------------------------------- 1 | se gw=75,5 2 | color guide #0000a0 3 | " For John and Liz 4 | se inputtab=spaces noautotab ml 5 | -------------------------------------------------------------------------------- /NLPW-2015/060-ref.txt: -------------------------------------------------------------------------------- 1 | References 2 | 3 | \$foo vs [ $foo ] 4 | 5 | bind_columns 6 | 7 | speed considerations 8 | -------------------------------------------------------------------------------- /NLPW-2015/015-irc.txt: -------------------------------------------------------------------------------- 1 | Freenode 2 | 3 | #perl6 4 | 5 | https://gist.github.com 6 | 7 | http://doc.perl6.org 8 | 9 | http://modules.perl6.org 10 | -------------------------------------------------------------------------------- /NLPW-2015/072-init.txt: -------------------------------------------------------------------------------- 1 | class C { 2 | 3 | has Int $.i = 0; 4 | has Bool $.b = False; 5 | 6 | } 7 | 8 | my $c = C.new (i => 1, b => True); 9 | -------------------------------------------------------------------------------- /csv-ruby.rb: -------------------------------------------------------------------------------- 1 | require "csv" 2 | 3 | i = 0 4 | CSV ($stdin) { |csv| 5 | csv.each { |row| 6 | i += row.length 7 | } 8 | } 9 | 10 | p i 11 | -------------------------------------------------------------------------------- /.whitesource: -------------------------------------------------------------------------------- 1 | { 2 | "generalSettings": { 3 | "shouldScanRepo": true 4 | }, 5 | "checkRunSettings": { 6 | "vulnerableCheckRunConclusionLevel": "failure" 7 | } 8 | } -------------------------------------------------------------------------------- /NLPW-2015/071-defaults.txt: -------------------------------------------------------------------------------- 1 | class C { 2 | 3 | has Int $.i = 0; 4 | 5 | has Str $.s is rw = "foo"; 6 | 7 | has CSV::Field @!fields; 8 | -------------------------------------------------------------------------------- /csv-R.R: -------------------------------------------------------------------------------- 1 | #!/usr/bin/Rscript 2 | csv <- read.csv ("/dev/stdin", header=FALSE) 3 | # TODO: make this actually count the fields instead of this fudge. 4 | print (nrow (csv) * ncol (csv)) 5 | -------------------------------------------------------------------------------- /csv-python2.py: -------------------------------------------------------------------------------- 1 | import sys 2 | import csv 3 | 4 | n = 0 5 | csvreader = csv.reader (sys.stdin, delimiter=",", quotechar='"') 6 | for row in csvreader: 7 | n += len (row) 8 | 9 | print n 10 | -------------------------------------------------------------------------------- /csv-python3.py: -------------------------------------------------------------------------------- 1 | import sys 2 | import csv 3 | 4 | n = 0 5 | csvreader = csv.reader (sys.stdin, delimiter=",", quotechar='"') 6 | for row in csvreader: 7 | n += len (row) 8 | 9 | print (n) 10 | -------------------------------------------------------------------------------- /sandbox/issue-34.csv: -------------------------------------------------------------------------------- 1 | 1664;4;5;35;37;43;5;6 2 | 1663;21;23;32;40;49;8;11 3 | 1662;16;17;34;35;44;5;10 4 | 1661;2;9;23;32;40;6;7" 5 | 1660;23;25;30;44;47;9;12 6 | 1659;3;5;9;32;43;6;10 7 | 1658;4;6;10;13;34;3;5 8 | -------------------------------------------------------------------------------- /t/99_meta.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use lib "lib"; 6 | 7 | use Test; 8 | use Test::META; 9 | 10 | plan 1; 11 | 12 | # That's it 13 | meta-ok (); 14 | 15 | done-testing; 16 | -------------------------------------------------------------------------------- /NLPW-2015/020-bugs.txt: -------------------------------------------------------------------------------- 1 | 2 | my int $i = 0; 3 | while ($i++ < 10) { 4 | 5 | => 6 | 7 | Cannot assign to an immutable value 8 | in sub postfix:<++> at src/gen/m-CORE.setting:5082 9 | in block at t.pl:7 10 | 11 | -------------------------------------------------------------------------------- /NLPW-2015/023-bugs.txt: -------------------------------------------------------------------------------- 1 | $ perl6 -e'$*OUT.nl = "\n"' 2 | 3 | 4 | $ perl6 -e'$*OUT.nl = ""' 5 | Invalid string index: max 4294967295, got 4294967295 6 | in block at src/gen/m-CORE.setting:17674 7 | in block at -e:1 8 | 9 | -------------------------------------------------------------------------------- /csv-pegex.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.16.2; 4 | use warnings; 5 | 6 | use Pegex::CSV; 7 | 8 | local $/; 9 | my $sum = 0; 10 | for (@{Pegex::CSV->load (<>)}) { 11 | $sum += scalar @$_; 12 | } 13 | say $sum; 14 | -------------------------------------------------------------------------------- /NLPW-2015/010-rakudo.txt: -------------------------------------------------------------------------------- 1 | $ git clone github.com:tadzik/rakudobrew ~/.rakudobrew 2 | $ cd ~/.rakudobrew 3 | $ export PATH=$PATH:~/.rakudobrew/bin 4 | $ rakudobrew build moar 5 | $ rakudobrew build-panda 6 | $ panda install Slang::Tuxic File::Temp Inline::Perl5 7 | -------------------------------------------------------------------------------- /NLPW-2015/021-bugs.txt: -------------------------------------------------------------------------------- 1 | use v6; 2 | use Slang::Tuxic; 3 | 4 | class C { 5 | method foo { self; } 6 | } 7 | 8 | my @foo = 1, "foo", Str, "2", Nil, 3, C.new; 9 | @foo.perl.say; 10 | 11 | 12 | => 13 | 14 | Array.new(1, "foo", Str, "2", 3, C.new) 15 | -------------------------------------------------------------------------------- /NLPW-2015/073-check.txt: -------------------------------------------------------------------------------- 1 | class C { 2 | 3 | has Int $.i = 0; 4 | has Bool $.b = False; 5 | 6 | method is-insane () returns Bool { 7 | ?$.i && $.b; 8 | } 9 | } 10 | 11 | my $c = C.new (i => 1, b => True); 12 | $c.is-insane.perl.say; 13 | -------------------------------------------------------------------------------- /csv-julia.jl: -------------------------------------------------------------------------------- 1 | using CSV 2 | 3 | function countCSVfields(file) 4 | n = 0 5 | for row in CSV.Rows(file; reusebuffer=true) 6 | n += length(row) 7 | end 8 | return n 9 | end 10 | 11 | println(countCSVfields("/tmp/hello.csv")) 12 | -------------------------------------------------------------------------------- /NLPW-2015/022-bugs.txt: -------------------------------------------------------------------------------- 1 | Int.Range.say 2 | 3 | => 4 | 5 | -Inf..Inf 6 | 7 | 8 | but 9 | 10 | my Int $i = Int.Range.max; 11 | 12 | => 13 | 14 | Type check failed in assignment to '$i'; expected 'Int' but got 'Num' 15 | in block at test.pl:4 16 | 17 | -------------------------------------------------------------------------------- /csv-easy-pp.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV::Easy_PP qw(csv_parse); 7 | 8 | my $sum = 0; 9 | while (my $line = <>) { 10 | my @row = csv_parse ($line); 11 | $sum += @row; 12 | } 13 | print "$sum\n"; 14 | -------------------------------------------------------------------------------- /csv-easy-xs.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV::Easy_XS qw(csv_parse); 7 | 8 | my $sum = 0; 9 | while (my $line = <>) { 10 | my @row = csv_parse ($line); 11 | $sum += @row; 12 | } 13 | print "$sum\n"; 14 | -------------------------------------------------------------------------------- /pj-epp.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV::Easy_PP; 7 | 8 | my $sum = 0; 9 | while (my $line = <>) { 10 | my @row = Text::CSV::Easy_PP::csv_parse ($line); 11 | $sum += @row; 12 | } 13 | print "$sum\n"; 14 | -------------------------------------------------------------------------------- /csv-pi-easy-pp.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV::Easy_PP; 7 | 8 | my $sum = 0; 9 | while (my $line = <>) { 10 | my @row = Text::CSV::Easy_PP::csv_parse ($line); 11 | $sum += @row; 12 | } 13 | print "$sum\n"; 14 | -------------------------------------------------------------------------------- /NLPW-2015/070-types.txt: -------------------------------------------------------------------------------- 1 | 2 | my Bool $b; 3 | my Int $i; 4 | my Str $s; 5 | my Num $n; 6 | my CSV::Field $f; 7 | 8 | 9 | method foo (IO:D $io, Str $s, Bool :$meta) returns Bool { 10 | 11 | sub blah (Int $x is rw, Int :$incr = 0) returns Str { 12 | -------------------------------------------------------------------------------- /rust-csvreader/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | 3 | name = "csvreader" 4 | version = "0.0.1" 5 | authors = [ "Your name " ] 6 | 7 | [[bin]] 8 | name = "csvreader" 9 | 10 | [dependencies] 11 | csv = "*" 12 | 13 | [profile.release] 14 | opt-level = 3 15 | lto = true 16 | -------------------------------------------------------------------------------- /dbi5.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.20.0; 4 | use warnings; 5 | 6 | use DBI; 7 | 8 | my $dbh = DBI->connect ("dbi:Pg:"); 9 | 10 | my $sth = $dbh->prepare ("select count (*) from url"); 11 | $sth->execute; 12 | $sth->bind_columns (\my $count); 13 | $sth->fetch; 14 | say $count; 15 | -------------------------------------------------------------------------------- /rust-libcsv/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "csvreader" 3 | version = "0.0.1" 4 | authors = [ "Ewan Higgs " ] 5 | 6 | [[bin]] 7 | name = "csvreader" 8 | 9 | [dependencies] 10 | libc = "0.2" 11 | num-traits = "0.1" 12 | 13 | [profile.release] 14 | opt-level = 3 15 | lto = true 16 | -------------------------------------------------------------------------------- /rust-quick-reader/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | 3 | name = "quick-reader" 4 | version = "0.0.1" 5 | authors = [ "Johann Tuffe " ] 6 | 7 | [[bin]] 8 | name = "quick-reader" 9 | 10 | [dependencies] 11 | quick-csv = "0.1" 12 | 13 | [profile.release] 14 | opt-level = 3 15 | lto = true 16 | -------------------------------------------------------------------------------- /csv-php.php: -------------------------------------------------------------------------------- 1 | #!/usr/bin/php 2 | 3 | 15 | -------------------------------------------------------------------------------- /NLPW-2015/035-chunks.txt: -------------------------------------------------------------------------------- 1 | 2 | for $buffer.split (rx{ $!eol | $!sep | $!quo | $!esc }, :all).map (~*) -> Str $chunk { 3 | 4 | : 5 | 6 | if $chunk eq $sep { 7 | $opt_v > 5 and progress($i, "SEP"); 8 | if $f.is_quoted { # "1,2" 9 | $f.add($chunk); 10 | next; 11 | } 12 | keep; # 1,2 13 | next; 14 | } 15 | 16 | -------------------------------------------------------------------------------- /NLPW-2015/018-debug.txt: -------------------------------------------------------------------------------- 1 | $ perl6 -e'.gist.say for 1, "test.pl".IO, 1/4, \4' 2 | 1 3 | "/srv/www/htdocs/Talks/CSV6/test.pl".IO 4 | 0.25 5 | \(4) 6 | 7 | $ perl6 -e'.perl.say for 1, "test.pl".IO, 1/4, \4' 8 | 1 9 | q|test.pl|.IO(:SPEC(IO::Spec::Unix),:CWD) 10 | 0.25 11 | Capture.new(list => (4,)) 12 | 13 | $ perl6 -e'(1/4).nude.say' 14 | 1 4 15 | -------------------------------------------------------------------------------- /csv-ip5xs.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Text::CSV_XS:from; 5 | 6 | my @rows; 7 | my $csv = Text::CSV_XS.new 8 | or die "Cannot use CSV: ", Text::CSV_XS.error_diag; 9 | $csv.binary(1); 10 | $csv.auto_diag(1); 11 | 12 | my Int $sum = 0; 13 | for lines :eager { 14 | $csv.parse($_); 15 | $sum += $csv.fields.elems; 16 | } 17 | $sum.say; 18 | -------------------------------------------------------------------------------- /rust-quick-reader/src/quick-reader.rs: -------------------------------------------------------------------------------- 1 | extern crate quick_csv as csv; 2 | 3 | fn main() { 4 | let fpath = ::std::env::args().nth(1).unwrap(); 5 | let rdr = csv::Csv::from_file(fpath).unwrap(); 6 | let sum = rdr.into_iter() 7 | .map(|r| r.unwrap().len()) 8 | .fold(0usize, |c, n| c + n); 9 | println!("{}", sum); 10 | } 11 | -------------------------------------------------------------------------------- /NLPW-2015/001-cope.txt: -------------------------------------------------------------------------------- 1 | Perl 5 2 | 3 | my @foo = sort map { foo ($_) } @{$object->bar (2)}; 4 | 5 | $str =~ s{foo}{bar}g; 6 | $str =~ m{([0-9]+)} and say $1; 7 | 8 | $scalar $array[1] $hash{foo} 9 | 10 | Perl 6 11 | 12 | my @foo = $object.bar (2).map ({ foo ($_) }).sort; 13 | 14 | $str ~~ s:g{ "foo" } = "bar"; 15 | $str =~ m{ (<[0..9]>+) } and $0.say; 16 | -------------------------------------------------------------------------------- /csv-test-pp.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV_PP; 7 | 8 | my @rows; 9 | my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 } ) 10 | or die "Cannot use CSV: ", Text::CSV->error_diag (); 11 | 12 | my $sum = 0; 13 | while (my $row = $csv->getline (*ARGV)) { 14 | $sum += scalar @$row; 15 | } 16 | print "$sum\n"; 17 | -------------------------------------------------------------------------------- /csv-test-xs.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV_XS; 7 | 8 | my @rows; 9 | my $csv = Text::CSV_XS->new ({ binary => 1, auto_diag => 1 } ) 10 | or die "Cannot use CSV: ", Text::CSV->error_diag (); 11 | 12 | my $sum = 0; 13 | while (my $row = $csv->getline (*ARGV)) { 14 | $sum += scalar @$row; 15 | } 16 | print "$sum\n"; 17 | -------------------------------------------------------------------------------- /csv-test-pp-pi.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV_PP; 7 | 8 | my @rows; 9 | my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 } ) 10 | or die "Cannot use CSV: ", Text::CSV->error_diag (); 11 | 12 | my $sum = 0; 13 | while (my $row = $csv->getline (*ARGV)) { 14 | $sum += scalar @$row; 15 | } 16 | print "$sum\n"; 17 | -------------------------------------------------------------------------------- /dbi6.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use Inline::Perl5; 6 | 7 | my $p5 = Inline::Perl5.new; 8 | 9 | $p5.use ("DBI"); 10 | 11 | my $dbh = $p5.invoke ("DBI", "connect", "dbi:Pg:"); 12 | 13 | my $sth = $dbh.prepare ("select count (*) from url"); 14 | $sth.execute; 15 | $sth.bind_columns (\my $count); 16 | my @count = $sth.fetchrow_array; 17 | @count[0].say; 18 | -------------------------------------------------------------------------------- /reasons.txt: -------------------------------------------------------------------------------- 1 | a. A signal that perl5 people care about raku (instead of the two camps 2 | yelling at eatchother) 3 | 4 | b. A signal the XS modules in perl5 can be performant in pure-raku 5 | 6 | c. As an exercise (to John and me) into how write raku that is so close 7 | to the system (my XS uses quite a bit of internal hackery) 8 | 9 | d. Motivate tadzik to write a slang for *me* 10 | -------------------------------------------------------------------------------- /t/92_csv_encoding.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new; 10 | 11 | my $fni = "_92in.csv"; 12 | END { unlink $fni; } 13 | 14 | spurt $fni, 'ID;Gerät;Nr', :enc; 15 | 16 | my $csv-in = csv :in($fni), :encoding('latin1'), :sep_char<;>; 17 | ok $csv-in, "No problems with encoding"; 18 | 19 | done-testing; 20 | -------------------------------------------------------------------------------- /csv-ip5xsio.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Text::CSV_XS:from; 5 | 6 | my @rows; 7 | my $csv = Text::CSV_XS.new 8 | or die "Cannot use CSV: ", Text::CSV_XS.error_diag; 9 | $csv.binary(1); 10 | $csv.auto_diag(1); 11 | 12 | my $fh = open "/tmp/hello.csv", :r, chomp => False; 13 | 14 | my Int $sum = 0; 15 | while (my $r = $csv.getline($fh)) { 16 | $sum += +$r; 17 | } 18 | $sum.say; 19 | -------------------------------------------------------------------------------- /sandbox/issue-32.raku: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use Text::CSV; 6 | 7 | my $csv = Text::CSV.new; 8 | my $fh = open "issue-32.csv", :r, :!chomp; 9 | my @hdr = $csv.header ($fh, munge-column-names => "fc").column-names; 10 | my @rows = $csv.getline_hr_all ($fh); .say for @rows; 11 | 12 | dd @hdr; 13 | 14 | Text::CSV.csv (in => "issue-32.csv", keep-headers => my @h); 15 | @h.dd; 16 | -------------------------------------------------------------------------------- /csv-go.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "encoding/csv" 5 | "fmt" 6 | "io" 7 | "os" 8 | ) 9 | 10 | func main () { 11 | 12 | reader := csv.NewReader (os.Stdin) 13 | sum := 0 14 | for { 15 | rows, err := reader.Read () 16 | if err == io.EOF { 17 | break 18 | } 19 | sum += len (rows) 20 | } 21 | fmt.Println (sum) 22 | } 23 | -------------------------------------------------------------------------------- /csv-parser.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use CSV::Parser; 6 | 7 | my $fh = open "/tmp/hello.csv", :r, chomp => False; 8 | my $parser = CSV::Parser.new (file_handle => $fh, contains_header_row => False); 9 | 10 | my int $r = 0; 11 | my int $sum = 0; 12 | while (my $rec = $parser.get_line) { 13 | $r++; 14 | my int $n = +$rec.keys or last; 15 | $sum += $n; 16 | } 17 | $sum.say; 18 | -------------------------------------------------------------------------------- /.github/workflows/test.yaml: -------------------------------------------------------------------------------- 1 | name: Test raku 2 | on: 3 | push: 4 | paths: 5 | - "META6.json" 6 | - "lib/**/*.rakumod" 7 | - "t/*.t" 8 | pull_request: 9 | types: [ opened,edited,synchronize,ready_for_review] 10 | jobs: 11 | test: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: Checkout 15 | uses: actions/checkout@v4 16 | - name: Test via install 17 | uses: JJ/raku-test-action@main 18 | -------------------------------------------------------------------------------- /NLPW-2015/074-build.txt: -------------------------------------------------------------------------------- 1 | class C { 2 | 3 | has Int $.i; 4 | has Bool $.b; 5 | 6 | submethod BUILD (*%init) { 7 | $.i = 0; 8 | $.b = False; 9 | 10 | ?%init{"i"} && %init{"b"} and die "Don't be insane!"; 11 | for keys %init -> $attr { 12 | ... 13 | } 14 | } 15 | 16 | method is-insane () returns Bool { 17 | ?$.i && $.b; 18 | } 19 | } 20 | 21 | my $c = C.new (i => 1, b => True); 22 | $c.is-insane.perl.say; 23 | -------------------------------------------------------------------------------- /examples/rewrite-tuxic.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # rewrite.pl: Convert SSV to CSV 4 | # (m)'18 Copyright H.M.Brand 2007-2018 5 | 6 | use v6; 7 | use Slang::Tuxic; 8 | use Text::CSV; 9 | 10 | @*ARGS.elems or @*ARGS.push: [ q:to/EOD/; 11 | a;b;c;d;e;f 12 | 1;2;3;4;5;6 13 | 2;3;4;5;6;7 14 | 3;4;5;6;7;8 15 | 4;5;6;7;8;9 16 | EOD 17 | ]; 18 | 19 | csv (in => csv (in => $_, sep_char => ";"), out => $*OUT) for @*ARGS; 20 | -------------------------------------------------------------------------------- /csv-ip5pp.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Inline::Perl5; 5 | 6 | my $p5 = Inline::Perl5.new; 7 | 8 | $p5.use("Text::CSV_PP"); 9 | 10 | my @rows; 11 | my $csv = $p5.invoke("Text::CSV_PP", "new") 12 | or die "Cannot use CSV: ", $p5.invoke("Text::CSV_PP", "error_diag"); 13 | $csv.binary(1); 14 | $csv.auto_diag(1); 15 | 16 | my Int $sum = 0; 17 | for lines :eager { 18 | $csv.parse($_); 19 | $sum += $csv.fields.elems; 20 | } 21 | $sum.say; 22 | -------------------------------------------------------------------------------- /csvJava.java: -------------------------------------------------------------------------------- 1 | import java.io.Reader; 2 | import java.io.InputStreamReader; 3 | import au.com.bytecode.opencsv.CSVReader; 4 | 5 | public class csvJava { 6 | 7 | public static void main (String[] args) throws Exception { 8 | 9 | CSVReader r = new CSVReader (new InputStreamReader (System.in), ',', '"'); 10 | int i = 0; 11 | String row[]; 12 | while ((row = r.readNext ()) != null) 13 | i += row.length; 14 | System.out.println (i); 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /csv-xsbc.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Text::CSV_XS; 7 | 8 | my @rows; 9 | my $csv = Text::CSV_XS->new ({ binary => 1, auto_diag => 1 } ) 10 | or die "Cannot use CSV: ", Text::CSV->error_diag (); 11 | 12 | my $row = $csv->getline (*ARGV); 13 | my @row = @$row; 14 | my $n = scalar @row; 15 | my $sum = $n; 16 | $csv->bind_columns (\(@row)); 17 | while ($csv->getline (*ARGV)) { 18 | $sum += $n; 19 | } 20 | print "$sum\n"; 21 | -------------------------------------------------------------------------------- /examples/rewrite.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # rewrite.pl: Convert SSV to CSV 4 | # (m)'18 Copyright H.M.Brand 2007-2018 5 | 6 | # Check rewrite-tuxic.pl for a version with the original style 7 | 8 | use v6; 9 | use Text::CSV; 10 | 11 | @*ARGS.elems or @*ARGS.push: [ q:to/EOD/; 12 | a;b;c;d;e;f 13 | 1;2;3;4;5;6 14 | 2;3;4;5;6;7 15 | 3;4;5;6;7;8 16 | 4;5;6;7;8;9 17 | EOD 18 | ]; 19 | 20 | csv(in => csv(in => $_, sep_char => ";"), out => $*OUT) for @*ARGS; 21 | -------------------------------------------------------------------------------- /NLPW-2015/032-grammar.txt: -------------------------------------------------------------------------------- 1 | grammar { 2 | token lines { * } 3 | token line { } 4 | token fields { * % } 5 | token field { : $= | $= } 6 | token value { [ <-separator> & <-quote> & <-lineend> ] * } 7 | token quotedvalue { <-quote> * } 8 | token separator { "$s" } 9 | token quote { "$q" } 10 | token escape { "$e" } 11 | token lineend { $l } 12 | } 13 | -------------------------------------------------------------------------------- /sandbox/issue-34.raku: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use Text::CSV; 6 | 7 | # https://github.com/Tux/CSV/issues/34 8 | # https://unix.stackexchange.com/a/755782/227738 9 | 10 | # Used the firt 7 lines of the example dat in the stackexchange post 11 | # Removed the last element from line 4, which should warn under strict 12 | 13 | my @a = csv (in => "sandbox/issue-34.csv", sep => ";", :auto-diag, :strict); 14 | 15 | @a = @a>>.map ({ sprintf "%.2d", $_ }); 16 | 17 | csv (in => @a, out => $*OUT, sep => ";"); 18 | -------------------------------------------------------------------------------- /NLPW-2015/081-errors.txt: -------------------------------------------------------------------------------- 1 | perl5 2 | 3 | foreach my $ws (" ", "\t") { 4 | $csv = Text::CSV_XS->new ({ escape_char = $ws }); 5 | eval { $csv->allow_white_space (1); }; 6 | is (0 +$csv->error_diag, 1002, "Sanity check"); 7 | 8 | 9 | perl6 10 | 11 | for (" ", "\t") -> $ws { 12 | my Int $e = 0; 13 | ok ($csv = Text::CSV.new (escape_char => $ws), "New blank escape"); 14 | { $csv.allow_whitespace (True); 15 | CATCH { default { $e = .error; }} 16 | } 17 | is ($e, 1002, "Sanity check"); 18 | 19 | -------------------------------------------------------------------------------- /NLPW-2015/005-slang.txt: -------------------------------------------------------------------------------- 1 | Legal in perl5: 2 | 3 | my $foo = foo( 1 ); 4 | my $foo = foo(1); 5 | my $foo = foo (1); 6 | my $foo = foo ( 1 7 | ); 8 | 9 | my $foo = $object->method (1) 10 | ->method (2) 11 | ->method (3); 12 | 13 | NOT legal in perl6 14 | 15 | my $foo = foo (1); 16 | my $foo = foo ( 1 17 | ); 18 | 19 | my $foo = $object.method(1) 20 | .method(2) 21 | .method(3); 22 | 23 | But with Slang::Tuxic they are! 24 | -------------------------------------------------------------------------------- /csv-lua.lua: -------------------------------------------------------------------------------- 1 | #!/usr/bin/lua 2 | 3 | local lpeg = require "lpeg" 4 | local field = '"' * lpeg.Cs (((lpeg.P (1) - '"') 5 | + lpeg.P'""' / '"')^0) * '"' 6 | + lpeg.C ((1 - lpeg.S',\n"')^0) 7 | 8 | local record = field * (',' * field)^0 * (lpeg.P'\n' + -1) 9 | 10 | function csv (s) 11 | return lpeg.match (record, s) 12 | end 13 | 14 | -- Count total number of fields from stdin 15 | local n = 0 16 | for l in io.stdin:lines () do 17 | local rec = { csv (l) } 18 | n = n + #rec 19 | end 20 | print (n) 21 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | CSV_XS* 2 | xx* 3 | test-x.pl 4 | tmp/ 5 | sandbox/cover_db* 6 | sandbox/i-ttt* 7 | sandbox/parse-*.png 8 | sandbox/print-*.png 9 | sandbox/rfc7111.odt 10 | sandbox/test.* 11 | profile*.html 12 | Text-CSV*.tgz 13 | Text-CSV*.tar.gz 14 | 15 | # And for CSV6 16 | t-old/* 17 | xt/??_* 18 | ?.pl 19 | ?.csv 20 | logotype/comma* 21 | .precomp 22 | lib/.precomp 23 | *.class 24 | *.jar 25 | csv-c 26 | csv-cc 27 | csv-go 28 | rust*/target 29 | .panda-work/* 30 | 31 | # Re-enable parts later 32 | sandbox/ 33 | files/ 34 | *~ 35 | 36 | # Comma stuff ignored 37 | .idea/ -------------------------------------------------------------------------------- /files/gitignore: -------------------------------------------------------------------------------- 1 | CSV_XS* 2 | xx* 3 | test-x.pl 4 | tmp/ 5 | sandbox/cover_db* 6 | sandbox/i-ttt* 7 | sandbox/parse-*.png 8 | sandbox/print-*.png 9 | sandbox/rfc7111.odt 10 | sandbox/test.* 11 | profile*.html 12 | Text-CSV*.tgz 13 | Text-CSV*.tar.gz 14 | 15 | # And for CSV6 16 | t-old/* 17 | xt/??_* 18 | ?.pl 19 | ?.csv 20 | logotype/comma* 21 | .precomp 22 | lib/.precomp 23 | *.class 24 | *.jar 25 | csv-c 26 | csv-cc 27 | csv-go 28 | rust*/target 29 | .panda-work/* 30 | 31 | # Re-enable parts later 32 | sandbox/ 33 | files/ 34 | *~ 35 | 36 | # Comma stuff ignored 37 | .idea/ -------------------------------------------------------------------------------- /NLPW-2015/111-multi.txt: -------------------------------------------------------------------------------- 1 | method !row_hr (@row) { 2 | my @cn = (@!crange ?? @!cnames[@!crange] !! @!cnames); 3 | hash @cn Z @row; 4 | } 5 | 6 | multi method getline_hr (Str $str, Bool :$meta = $!keep_meta) { 7 | @!cnames.elems or self!fail (3002); 8 | self!row_hr (self.getline ($str, :$meta)); 9 | } # getline_hr 10 | 11 | multi method getline_hr (IO:D $io, Bool :$meta = $!keep_meta) { 12 | @!cnames.elems or self!fail (3002); 13 | self!row_hr (self.getline ($io, :$meta)); 14 | } # getline_hr 15 | 16 | -------------------------------------------------------------------------------- /NLPW-2015/050-meta.txt: -------------------------------------------------------------------------------- 1 | $ perl5 -MCSV -e'dcsv (in => \q{1,,"2","",3})' 2 | [ 3 | [ 1, 4 | '', 5 | 2, 6 | '', 7 | 3 8 | ] 9 | ] 10 | 11 | $ perl5 -MCSV -e'dcsv (in => \q{1,,"2","",3}, blank_is_undef => 1)' 12 | [ 13 | [ 1, 14 | undef, 15 | 2, 16 | '', 17 | 3 18 | ] 19 | ] 20 | 21 | $ p6 -MText::CSV -e'csv(in => [q{1,,"2","",3}]).perl.say' 22 | [["1", "", "2", "", "3"]]<> 23 | 24 | $ p6 -MText::CSV -e'csv(in => [q{1,,"2","",3}], :blank-is-undef).perl.say' 25 | [["1", Str, "2", "", "3"]]<> 26 | 27 | -------------------------------------------------------------------------------- /rust-csvreader/src/csvreader.rs: -------------------------------------------------------------------------------- 1 | extern crate csv; 2 | 3 | fn main () { 4 | let fpath = ::std::env::args ().nth (1).unwrap (); 5 | let mut rdr = csv::Reader::from_file (fpath).unwrap ().has_headers (false); 6 | let mut sum = 0; 7 | loop { 8 | match rdr.next_bytes () { 9 | csv::NextField::Data (_) => sum += 1, 10 | csv::NextField::EndOfRecord => {} 11 | csv::NextField::EndOfCsv => break, 12 | csv::NextField::Error (err) => panic! ("{}", err), 13 | } 14 | } 15 | println!("{}", sum); 16 | } 17 | -------------------------------------------------------------------------------- /.aspell.local.pws: -------------------------------------------------------------------------------- 1 | personal_ws-1.1 en 999 2 | AoA 3 | API 4 | ASV 5 | attr 6 | bc 7 | BOM 8 | bom 9 | Buf 10 | ChangeLog 11 | colrange 12 | csvdiff 13 | csvkit 14 | dcsv 15 | DDumper 16 | diag 17 | EBCDIC 18 | ECB 19 | ECR 20 | EHK 21 | EHR 22 | EIF 23 | EIO 24 | EIQ 25 | elems 26 | eol 27 | EOL 28 | ESC 29 | fc 30 | foldcase 31 | FULLWIDTH 32 | getline 33 | grapheme 34 | hashrefs 35 | IANA 36 | INI 37 | jcsv 38 | Mattijsen 39 | multi 40 | munge 41 | ness 42 | NL 43 | NYI 44 | PapaParse 45 | posix 46 | PV 47 | QUO 48 | rowrange 49 | sep 50 | SetDiag 51 | STDERR 52 | Str 53 | undef 54 | UTF 55 | whitespace 56 | WIP 57 | xs 58 | -------------------------------------------------------------------------------- /sandbox/issue-34.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.018002; 4 | use warnings; 5 | use Text::CSV_XS qw( csv ); 6 | 7 | # https://github.com/Tux/CSV/issues/34 8 | # https://unix.stackexchange.com/a/755782/227738 9 | 10 | # Used the firt 7 lines of the example dat in the stackexchange post 11 | # Removed the last element from line 4, which should warn under strict 12 | 13 | -d "sandbox" and chdir "sandbox"; 14 | csv (sep => ";", in => 15 | csv (in => "issue-34.csv", 16 | sep => ";", 17 | auto_diag => 1, 18 | strict => 1, 19 | on_in => sub { $_ = sprintf "%02d", $_ for @{$_[1]} }, 20 | )); 21 | -------------------------------------------------------------------------------- /test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | export PERL6_VERBOSE=0 4 | 5 | perl -pe's/^ ?(?=\s*.opt_v)/#/' test-t.pl > test-x.pl 6 | 7 | ( 8 | for t in csv-easy-xs csv-easy-pp csv-test-xs csv-test-pp csv-pegex ; do 9 | echo 10 | echo "******* $t" 11 | head -30 /tmp/hello.csv | perl $t.pl >/dev/null 2>&1 12 | time perl $t.pl < /tmp/hello.csv 13 | done 14 | 15 | for t in csv csv_gram test test-x ; do 16 | echo 17 | echo "******* $t" 18 | head -30 /tmp/hello.csv | raku $t.pl >/dev/null 2>&1 19 | time raku $t.pl < /tmp/hello.csv 20 | done 21 | ) 2>&1 | perl -ne'm/^(user|sys|Array|\$)/ or print' 22 | 23 | rm -f test-x.pl 24 | -------------------------------------------------------------------------------- /t/81_subclass.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | class CSV2 is Text::CSV { 10 | } 11 | 12 | my $csv = CSV2.new; 13 | 14 | is ($csv.^name, "CSV2", "Classname"); 15 | 16 | is ($csv.version, Text::CSV.version, "Version"); 17 | 18 | ok ($csv.parse (""), "Subclass parse ()"); 19 | ok ($csv.combine (""), "Subclass combine ()"); 20 | is ($csv.binary (), True, "Basic attribute"); 21 | is ($csv.sep-char (), ",", "Aliassed attribute"); 22 | 23 | ok ($csv.new, "new () based on object"); 24 | 25 | done-testing; 26 | -------------------------------------------------------------------------------- /test-tuxic.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use Text::CSV; 6 | 7 | sub MAIN (:$getline, :$getline_all) { 8 | 9 | my $csv = Text::CSV.new; 10 | 11 | my Int $sum = 0; 12 | if ($getline_all) { # slowest 13 | $sum = [+] $csv.getline_all ($*IN)».map(*.elems); 14 | } 15 | elsif ($getline) { # middle, but safe 16 | while ($csv.getline ($*IN)) { 17 | $sum += $csv.fields.elems; 18 | } 19 | } 20 | else { # fastest, but unsafe 21 | for lines () { 22 | $csv.parse ($_); 23 | $sum += $csv.fields.elems; 24 | } 25 | } 26 | $sum.say; 27 | } 28 | -------------------------------------------------------------------------------- /NLPW-2015/030-state.txt: -------------------------------------------------------------------------------- 1 | enum State ; 2 | 3 | my Int $last = $line.chars; 4 | $index = 0; 5 | while $index < $last { 6 | $input = $line.substr ($index, 1); 7 | given $state { 8 | when State::Start { 9 | given $input { 10 | when $!sep_char { store; } 11 | when $!quote_char { non_nil; $state = State::QuotedData; } 12 | default { append ($_); $state = State::Data; } 13 | } 14 | } 15 | when State::Data { 16 | given $input { 17 | when $!sep_char { store; $state = State::Start; } 18 | when $!quote_char { parse_error ("Halfway quoting is forbidden"); } 19 | default { append ($_); } 20 | } 21 | } 22 | 23 | -------------------------------------------------------------------------------- /t/82_subclass.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | class Text::CSV::Subclass is Text::CSV { } 10 | 11 | ok (1, "Subclassed"); 12 | 13 | my $csvs = Text::CSV::Subclass.new (); 14 | is (~$csvs.error_diag (), "", "Last failure for new () - OK"); 15 | 16 | my $sc_csv; 17 | { my $e; 18 | { $sc_csv = Text::CSV::Subclass.new (:!auto_diag, ecs_char => ":"); 19 | CATCH { default { $e = $_; "" }} 20 | } 21 | is ($e.error, 1000, "Fail new because of unknown attribute"); 22 | is ($e.message, "INI - constructor failed: Unknown attribute 'ecs_char'", 23 | "Reason feeedback"); 24 | } 25 | is ($sc_csv.defined, False, "Unsupported attribute"); 26 | 27 | done-testing; 28 | -------------------------------------------------------------------------------- /csv-c.c: -------------------------------------------------------------------------------- 1 | /* #include */ 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | void field_count (void* str, size_t str_len, void* data) { 8 | int* count = (int*)data; 9 | *count += 1; 10 | } 11 | 12 | const int READ_SZ = 1024 * 1024; 13 | 14 | int main (int argc, char* argv[]) { 15 | struct csv_parser parser = {0}; 16 | csv_init (&parser, CSV_APPEND_NULL); 17 | char *buf = (char*)malloc (READ_SZ); 18 | size_t buflen = READ_SZ; 19 | int count = 0; 20 | while ((buflen = read (0, buf, READ_SZ)) > 0) { 21 | csv_parse (&parser, buf, buflen, field_count, 0, &count); 22 | } 23 | printf ("%d\n", count); 24 | free (buf); 25 | csv_free (&parser); 26 | return EXIT_SUCCESS; 27 | } 28 | -------------------------------------------------------------------------------- /make-dist: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.18.2; 4 | use warnings; 5 | use autodie; 6 | 7 | use JSON; 8 | use Archive::Tar; 9 | 10 | local $/; 11 | 12 | open my $fh, "<", "META6.json"; 13 | my $vsn = decode_json (<$fh>)->{version}; 14 | my $pfx = "Text-CSV-$vsn"; 15 | close $fh; 16 | 17 | my $tar = Archive::Tar->new; 18 | 19 | open my $mh, "<", "MANIFEST"; 20 | for (split m/\n/ => <$mh>) { 21 | open my $dh, "<", $_; 22 | substr $_, 0, 0, "$pfx/"; 23 | $tar->add_data ($_, <$dh>); 24 | close $dh; 25 | } 26 | close $mh; 27 | 28 | my $tgz = "$pfx.tgz"; 29 | unlink $tgz if -f $tgz; 30 | $tar->write ($tgz, COMPRESS_GZIP); 31 | 32 | my @s = stat $tgz; 33 | my @d = localtime $s[9]; 34 | printf "%9d %4d-%02d-%02d %02d:%02d:%02d %s\n", 35 | $s[7], $d[5] + 1900, ++$d[4], @d[3,2,1,0], $tgz; 36 | -------------------------------------------------------------------------------- /NLPW-2015/110-multi.txt: -------------------------------------------------------------------------------- 1 | multi method combine (Capture $c) returns Bool { 2 | multi method combine ( *@f) returns Bool { 3 | multi method combine ( @f) returns Bool { 4 | 5 | multi method getline_hr (Str $str, Bool :$meta = $!keep_meta) { 6 | multi method getline_hr (IO:D $io, Bool :$meta = $!keep_meta) { 7 | 8 | multi method getline (Str $str, Bool :$meta = $!keep_meta) { 9 | multi method getline (IO:D $io, Bool :$meta = $!keep_meta) { 10 | 11 | multi method print (IO:D $io, *%p) returns Bool { 12 | multi method print (IO:D $io, %c) returns Bool { 13 | multi method print (IO:D $io, Capture $c) returns Bool { 14 | multi method print (IO:D $io, @fld) returns Bool { 15 | multi method print (IO:D $io, *@fld) returns Bool { 16 | -------------------------------------------------------------------------------- /t/21_combine.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new (:quote-empty); 10 | 11 | my $expect = q{1,foo,"a b",,3,""}; 12 | 13 | my @args = (1, "foo", "a b", Str, 3, ""); 14 | ok ($csv.combine (1, "foo", "a b", Str, 3, ""), "combine (list)"); 15 | is ($csv.string, $expect, "string"); 16 | ok ($csv.combine ( @args), "combine (array)"); 17 | is ($csv.string, $expect, "string"); 18 | ok ($csv.combine (|@args), "combine (flattened array)"); 19 | is ($csv.string, $expect, "string"); 20 | ok ($csv.combine ([@args]), "combine (anon array)"); 21 | is ($csv.string, $expect, "string"); 22 | ok ($csv.combine (\(@args)), "combine (array ref)"); 23 | is ($csv.string, $expect, "string"); 24 | 25 | done-testing; 26 | -------------------------------------------------------------------------------- /rust-libcsv/Cargo.lock: -------------------------------------------------------------------------------- 1 | [root] 2 | name = "csvreader" 3 | version = "0.0.1" 4 | dependencies = [ 5 | "libc 0.2.18 (registry+https://github.com/rust-lang/crates.io-index)", 6 | "num-traits 0.1.36 (registry+https://github.com/rust-lang/crates.io-index)", 7 | ] 8 | 9 | [[package]] 10 | name = "libc" 11 | version = "0.2.18" 12 | source = "registry+https://github.com/rust-lang/crates.io-index" 13 | 14 | [[package]] 15 | name = "num-traits" 16 | version = "0.1.36" 17 | source = "registry+https://github.com/rust-lang/crates.io-index" 18 | 19 | [metadata] 20 | "checksum libc 0.2.18 (registry+https://github.com/rust-lang/crates.io-index)" = "a51822fc847e7a8101514d1d44e354ba2ffa7d4c194dcab48870740e327cac70" 21 | "checksum num-traits 0.1.36 (registry+https://github.com/rust-lang/crates.io-index)" = "a16a42856a256b39c6d3484f097f6713e14feacd9bfb02290917904fae46c81c" 22 | -------------------------------------------------------------------------------- /sandbox/issue-3.raku: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6.c; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new ( 10 | sep_char => "|", 11 | :binary, 12 | :allow_loose_quotes, 13 | :auto_diag, 14 | ); 15 | 16 | my $fh = IO::String.new (q{first|second|third|fourth|fifth|sixth|seventh|eigth|ninth|tenth|eleventh|twelth|thriteenth|fourteenth|fifteenth|sixteenth|seventeenth|eighteenth|nineteenth 17 | 1|||||||156999||12 Valley||D||N|3610|||68 V D|EA MATCH 18 | 2|||||||195658|"""The Cottage"" 54"|"""The "|K|||||307652|R, M|"""The ", K, |EA MATCH 19 | 3|||||||216058|117 The K|||||||||117 The K, |EA MATCH 20 | }); 21 | 22 | $csv.column_names ($csv.getline ($fh)); 23 | 24 | my $nbr_lines = 0; 25 | my @rows = $csv.getline_all ($fh); 26 | 27 | is (@rows.elems, 3, "processed expected number of lines"); 28 | 29 | done-testing; 30 | -------------------------------------------------------------------------------- /META6.json: -------------------------------------------------------------------------------- 1 | { "name" : "Text::CSV", 2 | "version" : "0.022", 3 | "perl" : "6.d", 4 | "description" : "Handle CSV data. API based on Perl's Text::CSV_XS", 5 | "auth" : "zef:Tux", 6 | "authors" : [ "H.Merijn Brand (Tux)" ], 7 | "tags" : [ "CSV","CPAN5" ], 8 | "depends" : [ "Slang::Tuxic", "File::Temp" ], 9 | "test-depends" : [ "Test", "Test::META" ], 10 | "provides" : { 11 | "Text::CSV" : "lib/Text/CSV.rakumod", 12 | "Text::IO::String" : "lib/Text/IO/String.rakumod" 13 | }, 14 | "repo-type" : "git", 15 | "source-url" : "git://github.com/Tux/CSV.git", 16 | "license" : "Artistic-2.0", 17 | "support" : { 18 | "irc" : "irc://irc.perl.org/#csv" 19 | }, 20 | "build-depends" : [ ], 21 | "resources" : [ ] 22 | } 23 | -------------------------------------------------------------------------------- /t/32_getline.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Text::CSV; 7 | use Text::IO::String; 8 | use Test; 9 | 10 | my $fh = Text::IO::String.new (q:to/EOC/); 11 | a,b,c 12 | 1,foo,bar 13 | EOC 14 | 15 | my int $i = 0; 16 | ok (my $csv = Text::CSV.new, "new CSV"); 17 | while (my @row = $csv.getline ($fh)) { 18 | $i++; 19 | } 20 | is ($i, 2, "Number of correct lines"); 21 | is (+$csv.error-diag, 2012, "Parse should have stopped with EOF"); 22 | $fh.close; 23 | 24 | # Check that while stops on error in getline 25 | $fh = Text::IO::String.new (q:to/EOC/); 26 | a,b,c 27 | 1,foo,bar 28 | 2,"d" fail,3 29 | 3,baz, 30 | EOC 31 | 32 | $i = 0; 33 | ok ($csv = Text::CSV.new, "new CSV"); 34 | while (@row = $csv.getline ($fh)) { 35 | $i++; 36 | } 37 | is ($i, 2, "Number of correct lines"); 38 | is (+$csv.error-diag, 2023, "Parse should have stopped on error"); 39 | 40 | done-testing; 41 | -------------------------------------------------------------------------------- /rust-quick-reader/Cargo.lock: -------------------------------------------------------------------------------- 1 | [root] 2 | name = "quick-reader" 3 | version = "0.0.1" 4 | dependencies = [ 5 | "quick-csv 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)", 6 | ] 7 | 8 | [[package]] 9 | name = "quick-csv" 10 | version = "0.1.0" 11 | source = "registry+https://github.com/rust-lang/crates.io-index" 12 | dependencies = [ 13 | "rustc-serialize 0.3.16 (registry+https://github.com/rust-lang/crates.io-index)", 14 | ] 15 | 16 | [[package]] 17 | name = "rustc-serialize" 18 | version = "0.3.16" 19 | source = "registry+https://github.com/rust-lang/crates.io-index" 20 | 21 | [metadata] 22 | "checksum quick-csv 0.1.0 (registry+https://github.com/rust-lang/crates.io-index)" = "303d7a32ce9f90979607dc564f4c151c55591926df33e77d0e235d41744b647e" 23 | "checksum rustc-serialize 0.3.16 (registry+https://github.com/rust-lang/crates.io-index)" = "1a48546a64cae47d06885e9bccadb99d0547d877a94c5167fa451ea33a484456" 24 | -------------------------------------------------------------------------------- /csv-cc.cc: -------------------------------------------------------------------------------- 1 | #include // cout, endl 2 | #include // fstream 3 | #include 4 | #include 5 | #include // copy 6 | #include // ostream_operator 7 | 8 | #include 9 | 10 | int main (int argc, char* argv[]) { 11 | std::string data; 12 | if (argc == 1) { 13 | data = "/dev/stdin"; 14 | } 15 | else { 16 | data = argv[1]; 17 | } 18 | 19 | std::ifstream in (data.c_str ()); 20 | if (!in.is_open ()) return 1; 21 | 22 | typedef boost::tokenizer> Tokenizer; 23 | 24 | std::vector vec; 25 | std::string line; 26 | int sum = 0; 27 | while (getline (in, line)) { 28 | Tokenizer tok (line); 29 | for (auto token : tok) { 30 | sum += 1; 31 | } 32 | } 33 | std::cout << sum << std::endl; 34 | } 35 | -------------------------------------------------------------------------------- /t/22_print.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | ok (my $csv = Text::CSV.new (:quote-empty, :blank-is-undef, :meta), "new"); 10 | 11 | my $tfn = "_22_print.csv"; 12 | 13 | my $args = q{1,foo,"a b",,3,""}; 14 | my @args = ("1", "foo", "a b", Str, "3", ""); # "1" instead of 1 for is-deeply 15 | 16 | my $fh = open $tfn, :w; 17 | ok ($csv.eol ("\r"), "EOL is CR for writing"); 18 | ok ($csv.print ($fh, 1, "foo", "a b", Str, 3, ""), "combine (list)"); 19 | ok ($csv.print ($fh, @args), "combine (array)"); 20 | ok ($csv.print ($fh, |@args), "combine (flattened array)"); 21 | ok ($csv.print ($fh, [@args]), "combine (anon array)"); 22 | ok ($csv.print ($fh, \(@args)), "combine (array ref)"); 23 | $fh.close; 24 | 25 | $fh = open $tfn, :r; 26 | is-deeply ([$csv.getline ($fh).map (~*)], @args, "getline") for ^5; 27 | $fh.close; 28 | 29 | unlink $tfn; 30 | 31 | done-testing; 32 | -------------------------------------------------------------------------------- /t/60_samples.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | # Some assorted examples from the XS' history 10 | 11 | # "Pavel Kotala" 12 | { 13 | my $csv = Text::CSV.new ( 14 | quote_char => '"', 15 | escape_char => '\\', 16 | sep_char => ';', 17 | binary => 1, 18 | ); 19 | ok ($csv, "new (\", \\\\, ;, 1)"); 20 | 21 | my @list = ("c:\\winnt", "text"); 22 | ok ($csv.combine (@list), "combine ()"); 23 | my $line = $csv.string; 24 | ok ($line, "string ()"); 25 | ok ($csv.parse ($line), "parse ()"); 26 | my @olist = $csv.fields; 27 | is (@list.elems, @olist.elems, "field count"); 28 | is (@list[0], @olist[0], "field 1"); 29 | is (@list[1], @olist[1], "field 2"); 30 | is-deeply ($csv.strings, @olist».text, "As strings"); 31 | } 32 | 33 | done-testing; 34 | -------------------------------------------------------------------------------- /sandbox/issue-32.csv: -------------------------------------------------------------------------------- 1 | User Name,First Name,Last Name,Display Name,Job Title,Department,Office Number,Office Phone,Mobile Phone,Fax,Address,City,State or Province,ZIP or Postal Code,Country or Region 2 | chris@contoso.com,Chris,Green,Chris Green,IT Manager,Information Technology,123451,123-555-1211,123-555-6641,123-555-9821,1 Microsoft way,Redmond,Wa,98052,United States 3 | ben@contoso.com,Ben,Andrews,Ben Andrews,IT Manager,Information Technology,123452,123-555-1212,123-555-6642,123-555-9822,1 Microsoft way,Redmond,Wa,98052,United States 4 | david@contoso.com,David,Longmuir,David Longmuir,IT Manager,Information Technology,123453,123-555-1213,123-555-6643,123-555-9823,1 Microsoft way,Redmond,Wa,98052,United States 5 | cynthia@contoso.com,Cynthia,Carey,Cynthia Carey,IT Manager,Information Technology,123454,123-555-1214,123-555-6644,123-555-9824,1 Microsoft way,Redmond,Wa,98052,United States 6 | melissa@contoso.com,Melissa,MacBeth,Melissa MacBeth,IT Manager,Information Technology,123455,123-555-1215,123-555-6645,123-555-9825,1 Microsoft way,Redmond,Wa,98052,United States 7 | -------------------------------------------------------------------------------- /NLPW-2015/080-errors.txt: -------------------------------------------------------------------------------- 1 | perl5 2 | 3 | ok (!$csv->parse ('"abc'), "Missing closing \""); 4 | 5 | is (0 + $csv->error_diag, 2027, "diag numeric"); 6 | is ("" . $csv->error_diag, "EIQ - Quoted field not terminated", "diag string"); 7 | my @ed = $csv->error_diag; 8 | is ($ed[2], 4, "diag pos"); 9 | is ($ed[3], 5, "diag record"); 10 | is ($ed[4], '"abc', "diag buffer"); 11 | is ($csv->error_diag[0], 2027, "diag error positional"); 12 | is ($csv->error_diag[3], 5, "diag record positional"); 13 | 14 | perl6 15 | 16 | ok (!$csv.parse ('"abc'), "Missing closing \""); 17 | 18 | is (0 + $csv.error_diag, 2027, "diag numeric"); 19 | is ("" ~ $csv.error_diag, "EIQ - Quoted field not terminated", "diag string"); 20 | my @ed = $csv.error_diag; 21 | is (@ed[2], 4, "diag pos"); 22 | is (@ed[3], 5, "diag record"); 23 | is (@ed[4], '"abc', "diag buffer"); 24 | is ($csv.error_diag[0], 2027, "diag error positional"); 25 | is ($csv.error_diag[3], 5, "diag record positional"); 26 | is ($csv.error_diag.error, 2027, "diag OO error"); 27 | is ($csv.error_diag.record, 5, "diag OO record"); 28 | -------------------------------------------------------------------------------- /rust-csvreader/Cargo.lock: -------------------------------------------------------------------------------- 1 | [root] 2 | name = "csvreader" 3 | version = "0.0.1" 4 | dependencies = [ 5 | "csv 0.14.3 (registry+https://github.com/rust-lang/crates.io-index)", 6 | ] 7 | 8 | [[package]] 9 | name = "byteorder" 10 | version = "0.3.13" 11 | source = "registry+https://github.com/rust-lang/crates.io-index" 12 | 13 | [[package]] 14 | name = "csv" 15 | version = "0.14.3" 16 | source = "registry+https://github.com/rust-lang/crates.io-index" 17 | dependencies = [ 18 | "byteorder 0.3.13 (registry+https://github.com/rust-lang/crates.io-index)", 19 | "rustc-serialize 0.3.16 (registry+https://github.com/rust-lang/crates.io-index)", 20 | ] 21 | 22 | [[package]] 23 | name = "rustc-serialize" 24 | version = "0.3.16" 25 | source = "registry+https://github.com/rust-lang/crates.io-index" 26 | 27 | [metadata] 28 | "checksum byteorder 0.3.13 (registry+https://github.com/rust-lang/crates.io-index)" = "29b2aa490a8f546381308d68fc79e6bd753cd3ad839f7a7172897f1feedfa175" 29 | "checksum csv 0.14.3 (registry+https://github.com/rust-lang/crates.io-index)" = "8fcb0d28c18dd9dafa7e5efd49d591f3383d12073568a3f7e0b5bc7c25a1bebc" 30 | "checksum rustc-serialize 0.3.16 (registry+https://github.com/rust-lang/crates.io-index)" = "1a48546a64cae47d06885e9bccadb99d0547d877a94c5167fa451ea33a484456" 31 | -------------------------------------------------------------------------------- /NLPW-2015/index: -------------------------------------------------------------------------------- 1 | * It is a different language, COPE! 2 | 3 | * I can haz spaces (Slang::Tuxic) 4 | 5 | * Keep current 6 | 7 | - rakudobrew 8 | 9 | - IRC 10 | 11 | * Debugging 12 | 13 | - .perl and .gist 14 | 15 | * BUGS, DEAL! (and report) 16 | 17 | * Approach 18 | 19 | - rewrite state machine 20 | 21 | - grammar-based 22 | 23 | - regex based 24 | 25 | . chunks of interest 26 | 27 | . flexibility 28 | 29 | * Test-driven (I have tests already) 30 | 31 | - test conversion 32 | 33 | - test speed 34 | 35 | . perl5 XS 36 | 37 | . perl5 PP 38 | 39 | . Inline::Perl5 40 | 41 | . perl6 State 42 | 43 | . perl6 Grammar 44 | 45 | . perl6 Chunks 46 | 47 | . perl6 CSV::Parse 48 | 49 | . perl6 Text::CSV (masak) 50 | 51 | * Meta info 52 | 53 | * References 54 | 55 | - \$foo vs [$foo] 56 | 57 | - bind_columns 58 | 59 | - speed (no advantage) 60 | 61 | * class contstructors 62 | 63 | - types 64 | 65 | - defaults 66 | 67 | - constraints 68 | 69 | - sanity checks 70 | 71 | - BUILD 72 | 73 | * Errors 74 | 75 | * Hooks 76 | 77 | * Ranges 78 | 79 | - lazy lists 80 | 81 | - pairs 82 | 83 | - cell-ranges 84 | 85 | - merging rfc7111 86 | 87 | * multi methods and hashes 88 | 89 | * csv () 90 | 91 | - In/Out 92 | -------------------------------------------------------------------------------- /Notes: -------------------------------------------------------------------------------- 1 | Str.^methods».name.grep: /uni/ 2 | 3 | $ p6 -e'Str.^methods».name.say' 4 | BUILD Int Num chomp chop pred succ match ords samecase samespace 5 | trim-leading trim-trailing trim encode wordcase trans indent codes 6 | path unival univals WHY WHICH Bool Str Stringy DUMP ACCEPTS Numeric 7 | gist perl comb subst-mutate subst lines split words 8 | 9 | $ p6 -e'Num.^methods».name.say' 10 | Num Bridge Int Rat FatRat succ pred isNaN abs log sqrt rand ceiling 11 | floor sin asin cos acos tan atan sec asec cosec acosec cotan acotan 12 | sinh asinh cosh acosh tanh atanh sech asech cosech acosech cotanh 13 | acotanh narrow sign conj atan2 round unpolar cis Complex exp 14 | truncate polymod base Real sleep log10 roots WHICH new perl Str 15 | Numeric ACCEPTS Bool gist DUMP 16 | 17 | $ p6 -e'Bool.^methods».name.say' 18 | Int pred succ key value pick roll enums Bool Numeric Str gist DUMP 19 | ACCEPTS perl 20 | 21 | $ p6 -e'"\x[00d0]\x[0110]\x[0189]".perl.say' 22 | "ÐĐƉ" 23 | $ p6 -e'say to-json "\x[00d0]\x[0110]\x[0189]"' 24 | "\u00d0\u0110\u0189" 25 | 26 | $ p6 -e'Int.Range.say' 27 | -Inf..Inf 28 | $ p6 -e'Int.Range.max.say' 29 | Inf 30 | $ p6 -e'int.Range.say' 31 | -9223372036854775808..9223372036854775807 32 | $ p6 -e'int.Range.max.say' 33 | 9223372036854775807 34 | 35 | • attribute defaults are ignored when the class has submethod BUILD 36 | -------------------------------------------------------------------------------- /test-t.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Text::CSV; 5 | 6 | sub MAIN (Bool :$getline, Bool :$getline_all, Bool :$hyper, Bool :$race) { 7 | 8 | my atomicint $sum = 0; 9 | if $getline_all { 10 | my $csv = Text::CSV.new; 11 | $sum = [+] $csv.getline_all($*IN)».map(*.elems); 12 | } 13 | 14 | elsif $getline { 15 | my $csv = Text::CSV.new; 16 | while $csv.getline($*IN) { 17 | $sum += $csv.fields.elems; 18 | } 19 | } 20 | 21 | elsif $hyper { 22 | # see https://irclog.perlgeek.de/perl6-dev/2017-10-20#i_15329645 23 | @*ARGS.pop; 24 | 25 | lines.hyper.map: { 26 | my $csv = once Text::CSV.new; 27 | $csv.parse($_); 28 | $sum ⚛+= $csv.fields.elems; 29 | } 30 | } 31 | 32 | elsif $race { 33 | # see https://irclog.perlgeek.de/perl6-dev/2017-10-20#i_15329645 34 | @*ARGS.pop; 35 | 36 | lines.race.map: { 37 | my $csv = once Text::CSV.new; 38 | $csv.parse($_); 39 | $sum ⚛+= $csv.fields.elems; 40 | } 41 | } 42 | 43 | else { 44 | my $csv = Text::CSV.new; 45 | for lines() { 46 | $csv.parse($_); 47 | $sum += $csv.fields.elems; 48 | } 49 | } 50 | $sum.say; 51 | } 52 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # General 2 | 3 | I am always open to improvements and suggestions. 4 | Use [issues](https://github.com/Tux/CSV/issues) 5 | 6 | # Style 7 | 8 | I will never accept pull request that do not strictly conform to my 9 | style, however you might hate it. You can read the reasoning behind 10 | my [preferences](http://tux.nl/style.html). 11 | 12 | If some co-maint accepts and pulls a pull-request, I will correct wrong 13 | indentation and spacing. 14 | 15 | I really do not care about mixed spaces and tabs in (leading) whitespace 16 | 17 | In perl5 code, Perl::Tidy will help getting the code in shape, but as all 18 | software, it is not perfect. You can find my preferences for these in 19 | [.perltidy](https://github.com/Tux/Release-Checklist/blob/master/.perltidyrc) and 20 | [.perlcritic](https://github.com/Tux/Release-Checklist/blob/master/.perlcriticrc). 21 | 22 | # Mail 23 | 24 | Please, please, please, do *NOT* use HTML mail. 25 | [Plain text](https://useplaintext.email) 26 | [without](http://www.goldmark.org/jeff/stupid-disclaimers/) 27 | [disclaimers](https://www.economist.com/business/2011/04/07/spare-us-the-e-mail-yada-yada) 28 | will do fine! 29 | 30 | # Requirements 31 | 32 | For raku, you cannot code in my style without 33 | [Slang::Tuxic](https://github.com/FROGGS/p6-Slang-Tuxic), but that is only 34 | needed for whitespace issues. You can do correct indentation without it. 35 | -------------------------------------------------------------------------------- /NLPW-2015/040-test.txt: -------------------------------------------------------------------------------- 1 | Test::More in perl5 2 | 3 | #!/usr/bin/perl 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Test::More tests => 177; 9 | 10 | BEGIN { 11 | use_ok "Text::CSV_XS"; 12 | plan skip_all => "Cannot load Text::CSV_XS" if $@; 13 | } 14 | 15 | ok (my $csv = Text::CSV_XS->new, "new ()"); 16 | 17 | is ($csv->quote_char, '"', "quote_char"); 18 | is ($csv->quote, '"', "quote"); 19 | is ($csv->escape_char, '"', "escape_char"); 20 | is ($csv->sep_char, ",", "sep_char"); 21 | is ($csv->sep, ",", "sep"); 22 | is ($csv->eol, "", "eol"); 23 | is ($csv->always_quote, 0, "always_quote"); 24 | : 25 | 26 | Test in perl6 27 | 28 | #!perl6 29 | 30 | use v6; 31 | use Slang::Tuxic; 32 | 33 | use Test; 34 | use Text::CSV; 35 | 36 | my $csv = Text::CSV.new; 37 | 38 | ok ($csv, "new ()"); 39 | 40 | is ($csv.quote_char, '"', "quote_char"); 41 | is ($csv.quote, '"', "quote"); 42 | is ($csv.escape_char, '"', "escape_char"); 43 | is ($csv.escape-char, '"', "escape-char"); 44 | is ($csv.sep, ",", "sep"); 45 | is ($csv.sep_char, ",", "sep_char"); 46 | is ($csv.sep-char, ",", "sep-char"); 47 | is ($csv.separator, ",", "separator"); 48 | is ($csv.eol.defined, False, "eol"); 49 | is ($csv.always_quote, False, "always_quote"); 50 | is ($csv.always-quote, False, "always-quote"); 51 | : 52 | -------------------------------------------------------------------------------- /t/31_row.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my CSV::Row $r .= new; 10 | 11 | is ($r.csv, Text::CSV, "No csv"); 12 | is ($r.fields.elems, 0, "No fields"); 13 | is ($r.Str, Str, "No csv to do string"); 14 | 15 | ok ($r.push (1), "push int"); 16 | ok ($r.push ("foo"), "push Str"); 17 | ok ($r.push (CSV::Field.new (2)), "push C::F (int)"); 18 | ok ($r.push (CSV::Field.new ("bar")), "push C::F (Str)"); 19 | 20 | is (+$r[0], 1, "1"); 21 | is (~$r[1], "foo", "foo"); 22 | is (+$r[2], 2, "2"); 23 | is (~$r[3], "bar", "bar"); 24 | 25 | ok (my $t = CSV::Row.new (csv => Text::CSV.new), "New with CSV"); 26 | $t.push ($r); 27 | 28 | is (~$t, "1,foo,2,bar", "String"); 29 | 30 | is ($t, Any, "No hash possible yet"); 31 | 32 | ok ($t.csv.column_names (), "Set headers"); 33 | 34 | is (~$t[0], "1", "Str indexed access"); 35 | is ( $t.Str, "foo", "Str hash access"); 36 | is (+$t[2], 2, "Num indexed access"); 37 | is (~$t, "bar", "Str hash access"); 38 | 39 | is-deeply ( $t.hash, { :A("1"), :B("foo"), :C("2"), :D("bar") }, "hash"); 40 | is-deeply ([$t.strings], [ "1", "foo", "2", "bar" ], "strings"); 41 | 42 | my $csv = Text::CSV.new (:!keep_meta); 43 | is-deeply ([$csv.getline ("foo,bar,zip")], [], "getline"); 44 | ok (my $row = $csv.row, "Get last row"); 45 | is-deeply ([$row.strings], [], "strings"); 46 | 47 | done-testing; 48 | -------------------------------------------------------------------------------- /NLPW-2015/051-meta.txt: -------------------------------------------------------------------------------- 1 | perl5 2 | 3 | ok ( $csv->parse (qq("","I said,\t""Hi!""",)), "Hi! - parse ()"); 4 | is ( scalar $csv->fields (), 3, "Hi! - fields () - count"); 5 | is ( scalar $csv->meta_info (), 3, "Hi! - meta_info () - count"); 6 | 7 | is (($csv->fields ())[0], "", "Hi! - fields () - field 1"); 8 | is (($csv->meta_info ())[0], 1, "Hi! - meta_info () - field 1"); 9 | is (($csv->fields ())[1], qq(I said,\t"Hi!"), "Hi! - fields () - field 2"); 10 | is (($csv->meta_info ())[1], 1, "Hi! - meta_info () - field 2"); 11 | is (($csv->fields ())[2], "", "Hi! - fields () - field 3"); 12 | is (($csv->meta_info ())[2], 0, "Hi! - meta_info () - field 3"); 13 | 14 | perl6 15 | 16 | ok ($csv.parse (qq{,"I said,\t""Hi!""",""}), "Hi! - parse ()"); 17 | is ($csv.fields.elems, 3, "Hi! - fields () - count"); 18 | is ($csv.fields[0].text, "", "comma - fields () - content"); 19 | is ($csv.fields[0].is_quoted, False, "comma - fields () - quoted"); 20 | is ($csv.fields[1].text, "I said,\t\"Hi!\"", "comma - fields () - content"); 21 | is ($csv.fields[1].is_quoted, True, "comma - fields () - quoted"); 22 | is ($csv.fields[2].text, "", "comma - fields () - content"); 23 | is ($csv.fields[2].is_quoted, True, "comma - fields () - quoted"); 24 | is_deeply ([$csv.list], ["",qq{I said,\t"Hi!"},""], "As list"); 25 | 26 | -------------------------------------------------------------------------------- /time-twice.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.18.2; 4 | use warnings; 5 | 6 | $| = 1; 7 | binmode STDOUT, ":encoding(utf-8)"; 8 | 9 | use Getopt::Long qw(:config bundling passthrough); 10 | GetOptions ( 11 | "s|silent!" => \my $opt_s, 12 | ) or die "usage: $0 [--silent] [options to time.pl]\n"; 13 | 14 | my (@v, %t, %seen); 15 | foreach my $i (1, 2) { 16 | print "\r"; 17 | open my $th, "-|", "time.pl", @ARGV; 18 | binmode $th, ":encoding(utf-8)"; 19 | while (<$th>) { 20 | if (m/^([^ ]+[ ]+[^ ]+)[ ]+(?:\**[ ]+)?[0-9]/) { 21 | print $seen{$1}++ || $opt_s ? "." : $_; 22 | next; 23 | } 24 | # print; 25 | if (m/^(?:This is|Welcome to)\s.*\s(v\d+[-.\w]+?)\.?$/) { 26 | $v[0] //= "Rakudo $1"; 27 | next; 28 | } 29 | if (m/^Implementing\s.*(v\d\S+?)\.?$/) { 30 | $v[1] //= " ($1)"; 31 | next; 32 | } 33 | if (m/^Built on (\w+)\s+version\s+(\S+?)\.?$/) { 34 | $v[2] //= " on $1 $2"; 35 | next; 36 | } 37 | my ($s, $t) = m/^(.+?)\s+([0-9][.0-9]+)$/ or next; 38 | push @{$t{$s =~ s/(?:\s+|\xa0|\x{00a0})+/ /gr}}, $t; 39 | } 40 | } 41 | 42 | say ""; 43 | say join "" => grep { length } @v; 44 | foreach my $t (sort { $t{$a}[0] <=> $t{$b}[0] } keys %t) { 45 | my @t = sort { $a <=> $b } @{$t{$t}}; 46 | printf "%-18s %s\n", $t, join " - " => map { sprintf "%6.3f", $_ } @t[0,-1]; 47 | } 48 | 49 | say "https://tux.nl/Talks/CSV6/speed4-20.html / https://tux.nl/Talks/CSV6/speed4.html https://tux.nl/Talks/CSV6/speed.log"; 50 | -------------------------------------------------------------------------------- /lib/Text/IO/String.rakumod: -------------------------------------------------------------------------------- 1 | use Slang::Tuxic; # Need it for space before parenthesis 2 | 3 | unit class Text::IO::String is IO::Handle; 4 | 5 | has $.nl-in is rw; 6 | has $.nl-out is rw; 7 | has Bool $.ro is rw is default(False); 8 | has Str $!str; 9 | has Str @!content; 10 | 11 | # my $fh = Text::IO::String.new ($foo); 12 | multi method new (Str $str! is rw, *%init) { 13 | my \obj = self.new ($str.Str, |%init); 14 | obj.bind-str ($str); 15 | obj; 16 | } 17 | 18 | # my $fh = Text::IO::String.new ("foo"); 19 | multi method new (Str $str!, *%init) { 20 | my \obj = self.bless; 21 | obj.nl-in = $*IN.nl-in; 22 | obj.nl-out = $*OUT.nl-out; 23 | obj.ro = %init if %init:exists; 24 | obj.nl-in = %init if %init:exists; 25 | obj.nl-out = %init if %init:exists; 26 | obj.print ($str); 27 | obj; 28 | } 29 | 30 | method bind-str (Str $s is rw) { 31 | $!str := $s; 32 | } 33 | 34 | method print (*@what) { 35 | if (my Str $str = @what.join ("")) { 36 | my Str @x = $str eq "" || !$.nl-in.defined 37 | ?? $str 38 | !! |$str.split ($.nl-in, :v).map (-> $a, $b? --> Str { $a ~ ($b // "") }); 39 | @x.elems > 1 && @x.tail eq "" and @x.pop; 40 | @!content.push: |@x; 41 | } 42 | self; 43 | } 44 | 45 | method print-nl { 46 | self.print ($.nl-out); 47 | } 48 | 49 | method get { 50 | @!content ?? @!content.shift !! Str; 51 | } 52 | 53 | method close { 54 | $!str.defined && !$.ro and $!str = ~ self; 55 | } 56 | 57 | method Str { 58 | @!content.join (""); 59 | } 60 | -------------------------------------------------------------------------------- /examples/speed-tuxic.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # speed.pl: compare different versions of Text-CSV* modules 4 | # (m)'18 [06 Sep 2018] Copyright H.M.Brand 2007-2018 5 | 6 | use v6; 7 | use Slang::Tuxic; 8 | use Text::CSV; 9 | use Bench; 10 | 11 | my $b = Bench.new; 12 | my $csv = Text::CSV.new (eol => "\n"); 13 | 14 | my Str @fields1 = ( 15 | "Wiedmann", "Jochen", 16 | "Am Eisteich 9", 17 | "72555 Metzingen", 18 | "Germany", 19 | "+49 7123 14881", 20 | "joe\@ispsoft,de"); 21 | my @fields10 = (@fields1) xx 10; 22 | my @fields100 = (@fields1) xx 100; 23 | 24 | $csv.combine (@fields1 ); my $str1 = $csv.string; 25 | $csv.combine (@fields10 ); my $str10 = $csv.string; 26 | $csv.combine (@fields100); my $str100 = $csv.string; 27 | 28 | $b.timethese (100, { 29 | 30 | "combine 1" => sub { $csv.combine (@fields1 ) }, 31 | "combine 10" => sub { $csv.combine (@fields10 ) }, 32 | "combine 100" => sub { $csv.combine (@fields100) }, 33 | 34 | "parse 1" => sub { $csv.parse ($str1 ) }, 35 | "parse 10" => sub { $csv.parse ($str10 ) }, 36 | "parse 100" => sub { $csv.parse ($str100 ) }, 37 | }); 38 | 39 | my $line_count = 5000; 40 | 41 | my $bigfile = "_file.csv"; 42 | my $io = open $bigfile, :w; 43 | 44 | $csv.print ($io, @fields10) or die "Cannot print ()\n"; 45 | $b.timethese ($line_count, { 46 | "print io" => sub { $csv.print ($io, @fields10) }, 47 | }); 48 | $io.close; 49 | my $l = $bigfile.IO.s; 50 | $l or die "Buffer/file is empty!\n"; 51 | my @f = @fields10; 52 | #$csv.can ("bind_columns") and $csv.bind_columns (\(@f)); 53 | $io = open $bigfile; 54 | $b.timethese ($line_count, { 55 | "getline io" => sub { $csv.getline ($io) }, 56 | }); 57 | $io.close; 58 | print "Data was $l bytes long, line length {$str10.chars}\n"; 59 | unlink $bigfile; 60 | -------------------------------------------------------------------------------- /examples/speed.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # speed.pl: compare different versions of Text-CSV* modules 4 | # (m)'18 [06 Sep 2018] Copyright H.M.Brand 2007-2018 5 | 6 | # Check speed-tuxic.pl for a version with the original style 7 | 8 | use v6; 9 | use Text::CSV; 10 | use Bench; 11 | 12 | my $b = Bench.new; 13 | my $csv = Text::CSV.new(eol => "\n"); 14 | 15 | my Str @fields1 = ( 16 | "Wiedmann", "Jochen", 17 | "Am Eisteich 9", 18 | "72555 Metzingen", 19 | "Germany", 20 | "+49 7123 14881", 21 | "joe\@ispsoft,de"); 22 | my @fields10 = (@fields1) xx 10; 23 | my @fields100 = (@fields1) xx 100; 24 | 25 | $csv.combine(@fields1 ); my $str1 = $csv.string; 26 | $csv.combine(@fields10 ); my $str10 = $csv.string; 27 | $csv.combine(@fields100); my $str100 = $csv.string; 28 | 29 | $b.timethese(100, { 30 | 31 | "combine 1" => sub { $csv.combine(@fields1 ) }, 32 | "combine 10" => sub { $csv.combine(@fields10 ) }, 33 | "combine 100" => sub { $csv.combine(@fields100) }, 34 | 35 | "parse 1" => sub { $csv.parse($str1 ) }, 36 | "parse 10" => sub { $csv.parse($str10 ) }, 37 | "parse 100" => sub { $csv.parse($str100 ) }, 38 | }); 39 | 40 | my $line_count = 5000; 41 | 42 | my $bigfile = "_file.csv"; 43 | my $io = open $bigfile, :w; 44 | 45 | $csv.print($io, @fields10) or die "Cannot print()\n"; 46 | $b.timethese($line_count, { 47 | "print io" => sub { $csv.print($io, @fields10) }, 48 | }); 49 | $io.close; 50 | my $l = $bigfile.IO.s; 51 | $l or die "Buffer/file is empty!\n"; 52 | my @f = @fields10; 53 | #$csv.can("bind_columns") and $csv.bind_columns(\(@f)); 54 | $io = open $bigfile; 55 | $b.timethese($line_count, { 56 | "getline io" => sub { $csv.getline($io) }, 57 | }); 58 | $io.close; 59 | print "Data was $l bytes long, line length {$str10.chars}\n"; 60 | unlink $bigfile; 61 | -------------------------------------------------------------------------------- /t/47_comment.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # Cannot set $*OUT.nl-out to Str 4 | 5 | use v6; 6 | use Slang::Tuxic; 7 | 8 | use Test; 9 | use Text::CSV; 10 | 11 | my $efn = "_cmnt.csv"; 12 | my @cs = "#", "//", "Comment ", "\x[2603]"; 13 | my @rst = "", " 1,2", "a,b"; 14 | 15 | for (|@cs) -> $cs { 16 | for (|@rst) -> $rs { 17 | 18 | my $csv = Text::CSV.new (); 19 | $csv.comment-str ($cs); 20 | 21 | my IO::Handle $fh = open $efn, :w; 22 | $fh.say ( $cs, $rs); 23 | $fh.say ("c,", $cs ); 24 | $fh.say (" ", $cs ); 25 | $fh.say ("e,", $cs, ",", $rs); 26 | $fh.say ( $cs ); 27 | $fh.say ("g,i", $cs ); 28 | $fh.say ("j,\"k\n", $cs, "k\"" ); 29 | $fh.close; 30 | 31 | $fh = open $efn, :r; 32 | 33 | my @r = $rs.split (","); 34 | is-deeply ($csv.getline ($fh), [ "c", $cs ], "$cs , $rs"); 35 | is-deeply ($csv.getline ($fh), [ " $cs" ], "leading space"); 36 | is-deeply ($csv.getline ($fh), [ "e", $cs, |@r ], "not start of line"); 37 | is-deeply ($csv.getline ($fh), [ "g", "i$cs" ], "not start of field"); 38 | is-deeply ($csv.getline ($fh), [ "j", "k\n$cs"~"k" ], "inside quoted after newline"); 39 | 40 | $fh.close; 41 | 42 | unlink $efn; 43 | } 44 | } 45 | 46 | { my IO::Handle $fh = open $efn, :w; 47 | $fh.say ("id | name"); 48 | $fh.say ("# "); 49 | $fh.say ("42 | foo"); 50 | $fh.say ("#"); 51 | $fh.close; 52 | 53 | is-deeply ([csv ( 54 | in => $efn, 55 | sep => "|", 56 | headers => "auto", 57 | allow_whitespace => 1, 58 | comment_str => "#", 59 | )], [{ :id("42"), :name("foo") },], "Auto with last line comment"); 60 | 61 | unlink $efn; 62 | } 63 | 64 | done-testing; 65 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Module [![Test raku](https://github.com/Tux/CSV/actions/workflows/test.yaml/badge.svg)](https://github.com/Tux/CSV/actions/workflows/test.yaml) 2 | ------ 3 | Text::CSV - Handle CSV data in Raku 4 | 5 | Description 6 | ----------- 7 | Text::CSV provides facilities for the composition and decomposition 8 | of comma-separated values. An instance of the Text::CSV class can 9 | combine fields into a CSV string and parse a CSV string into fields. 10 | 11 | This module provides both an OO API and a functional API to parse 12 | and produce CSV data. 13 | ``` 14 | use Text::CSV; 15 | 16 | my $csv = Text::CSV.new; 17 | my $io = open "file.csv", :r, chomp => False; 18 | my @dta = $csv.getline_all($io); 19 | 20 | my @dta = csv(in => "file.csv"); 21 | ``` 22 | 23 | Additional (still incomplete) documentation in [the `doc` directory](/doc), including [a markdown version](/doc/Text-CSV.md). Check out also the [examples](/examples). 24 | 25 | Debugging information can be obtained by setting the `RAKU_VERBOSE` 26 | environment variable with values ranging to 2 to 9, less to annoyingly verbose. 27 | 28 | ## Installation 29 | 30 | Recent changes can be (re)viewed in the public GIT repository at 31 | https://github.com/Tux/CSV 32 | Feel free to clone your own copy: 33 | ``` 34 | $ git clone https://github.com/Tux/CSV Text-CSV 35 | ``` 36 | 37 | Prerequisites 38 | ------------- 39 | * raku 6.c 40 | * File::Temp - as long as in-memory IO is not native 41 | * Slang::Tuxic - to support my style 42 | 43 | Build/Installation 44 | ------------------ 45 | ``` 46 | $ zef install Text::CSV 47 | ``` 48 | 49 | Or just 50 | 51 | ```shell 52 | $ zef install . 53 | ``` 54 | 55 | for the already downloaded repo 56 | 57 | License 58 | ------- 59 | Copyright (c) 2015-2023 H.Merijn Brand. All rights reserved. 60 | 61 | This program is free software; you can redistribute it and/or 62 | modify it under the same terms as Raku itself, which is 63 | GNU General Public License or Artistic License 2. 64 | 65 | 66 | Author 67 | ------ 68 | H.Merijn Brand 69 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | • PASS more tests 2 | 3 | • Str/Buf/Blob - binary data (+ tests) 4 | 5 | Current thought: remove the meaning of "binary" as currently is 6 | implemented, as everything is valid Str already. 7 | 8 | Add binary support by allowing *real* binary (images, raw data) 9 | by adding a Blob entry in CSV::Field and use that instead of the 10 | current Str $.text by using CATCH blocks. 11 | 12 | When fetching the field, check if Buf is set and return that (if 13 | possible) 14 | 15 | Str = String of characters 16 | Buf = Mutable buffer for binary data 17 | Blob = Common interface for binary large objects 18 | 19 | • csv () function 20 | 21 | • Documentation 22 | 23 | • Speed 24 | 25 | Once Regexes are "fast" again, and $!eol can be embedded in $chx, 26 | re-enable the ~~ $eol again. For now disable the use of Regex in 27 | eol attribute. 28 | 29 | new (eol => Str, # supported 30 | new (eol => "\n", # supported 31 | new (eol => "\r\n", # supported 32 | new (eol => rx{ \s* \r?\n }, # future 33 | 34 | • Decide if types should be dealt with beyond current overloading 35 | 36 | Also of possible impact to Text::CSV.list 37 | 38 | See use of hashes (_hr) 39 | 40 | Decide if $!meta should be an attribute again, so .list and .fields 41 | can merge. Mind csv () and fragment ("cells="...") 42 | 43 | • bind_columns and hashes 44 | 45 | If returning hashes, consider if returning Str:Str kv pairs is 46 | the way to go instead of Str:CSV::Field. If so, then column types 47 | might be useful again. 48 | 49 | • merge masak's Text::CSV 50 | 51 | :strict 52 | 53 | Throw an error if a row has a different number of columns than 54 | the previous ones. 55 | 56 | :trim 57 | 58 | Removes whitespace on both ends of each value.Currently implemented 59 | as :allow-whitespace, but that does not trim inside quotation 60 | 61 | :skip-header 62 | 63 | Causes the first line not to be included in the output. Function & 64 | method csv () already supports headers => "skip" (NYI) 65 | -------------------------------------------------------------------------------- /NLPW-2015/090-hooks.txt: -------------------------------------------------------------------------------- 1 | perl5 2 | 3 | my $callbacks = { 4 | error => \&ignore, 5 | after_parse => sub { 6 | my ($c, $av) = @_; 7 | # Just add a field 8 | push @$av, "NEW"; 9 | }, 10 | before_print => sub { 11 | my ($c, $av) = @_; 12 | # First field set to line number 13 | $av->[0] = $idx++; 14 | # Maximum 2 fields 15 | @{$av} > 2 and splice @{$av}, 2; 16 | # Minimum 2 fields 17 | @{$av} < 2 and push @{$av}, ""; 18 | }, 19 | }; 20 | is (ref $csv->callbacks ($callbacks), "HASH", "callbacks set"); 21 | ok ($csv->getline (*DATA), "parse ok"); 22 | is ($c, 1, "key"); 23 | is ($s, "foo", "value"); 24 | ok ($csv->getline (*DATA), "parse bad, skip 3006"); 25 | ok ($csv->getline (*DATA), "parse good"); 26 | is ($c, 2, "key"); 27 | is ($s, "bar", "value"); 28 | 29 | perl6 30 | 31 | sub Empty (Text::CSV $c, CSV::Field @f) {} 32 | sub Drop (Text::CSV $c, CSV::Field @f) { @f.pop; } 33 | sub Push (Text::CSV $c, CSV::Field @f) { @f.push (CSV::Field.new); } 34 | sub Replc (Text::CSV $c, CSV::Field @f) { @f[1] = CSV::Field.new; } 35 | sub Unshf (Text::CSV $c, CSV::Field @f) { @f.unshift (CSV::Field.new ("0")); } 36 | 37 | ok ($csv.meta (True), "Set meta again"); 38 | is_deeply ([$csv.getline ("1,2").map (~*)], ["1","2"], "Parse no cb"); 39 | 40 | ok ($csv.callbacks ("after_parse", &Empty), "Empty ap cb"); 41 | is_deeply ([$csv.getline ("1,2").map (~*)], ["1","2"], "Parse empty cb"); 42 | 43 | ok ($csv.callbacks ("after_parse", &Drop), "Drop ap cb"); 44 | is_deeply ([$csv.getline ("1,2").map (~*)], ["1"], "Parse dropping cb"); 45 | 46 | ok ($csv.callbacks ("after_parse", &Push), "Push ap cb"); 47 | is_deeply ([$csv.getline ("1,2").map (~*)], ["1","2",Str], "Parse pushing cb"); 48 | 49 | ok ($csv.callbacks ("after_parse", &Replc), "Replc ap cb"); 50 | is_deeply ([$csv.getline ("1,2").map (~*)], ["1",Str], "Parse pushing cb"); 51 | 52 | ok ($csv.callbacks ("after_parse", &Unshf), "Unshf ap cb"); 53 | is_deeply ([$csv.getline ("1,2").map (~*)], ["0","1","2"], "Parse unshifting cb"); 54 | 55 | -------------------------------------------------------------------------------- /t/40_misc.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | sub is_binary (Str $got, Str $exp, Str $tst) { is ($got.perl, $exp.perl, $tst); } 10 | 11 | my @binField = ("abc\0def\n\rghi", "ab\"ce,\x[1a]\"'", "\x[ff]"); 12 | 13 | my $csv = Text::CSV.new (:binary, :escape-null); 14 | ok ($csv.combine (@binField), "combine ()"); 15 | 16 | my $string; 17 | is_binary ($string = $csv.string, 18 | qq{"abc"0def\n\rghi","ab""ce,\x[1a]""'",\x[ff]}, "string ()"); 19 | 20 | ok ($csv.parse ($string), "parse ()"); 21 | is ($csv.fields.elems, @binField.elems, "field count"); 22 | 23 | my @field = $csv.fields (); 24 | for (flat 0 .. @binField.elems - 1) { 25 | is (@field[$_].text, @binField[$_], "Field $_"); 26 | } 27 | 28 | ok (1, "eol \\r\\n"); 29 | $csv.eol ("\r\n"); 30 | ok ($csv.combine (@binField), "combine ()"); 31 | is_binary ($csv.string, 32 | qq{"abc"0def\n\rghi","ab""ce,\x[1a]""'",\x[ff]\r\n}, "string ()"); 33 | 34 | ok (1, "eol \\n"); 35 | $csv.eol ("\n"); 36 | ok ($csv.combine (@binField), "combine ()"); 37 | is_binary ($csv.string, 38 | qq{"abc"0def\n\rghi","ab""ce,\x[1a]""'",\x[ff]\n}, "string ()"); 39 | 40 | ok (1, "eol ,xxxxxxx\\n"); 41 | $csv.eol (",xxxxxxx\n"); 42 | ok ($csv.combine (@binField), "combine ()"); 43 | is_binary ($csv.string, 44 | qq{"abc"0def\n\rghi","ab""ce,\x[1a]""'",\x[ff],xxxxxxx\n}, "string ()"); 45 | 46 | $csv.eol ("\n"); 47 | ok (1, "quote_char Str"); 48 | $csv.quote_char (Str); 49 | ok ($csv.combine ("abc","def","ghi"), "combine"); 50 | is ($csv.string, "abc,def,ghi\n", "string ()"); 51 | 52 | ok (1, "always_quote"); 53 | my $csv2 = Text::CSV.new (:always_quote); 54 | ok ($csv2, "new ()"); 55 | ok ($csv2.combine ("abc","def","ghi"), "combine ()"); 56 | is ($csv2.string, '"abc","def","ghi"', "string ()"); 57 | 58 | done-testing; 59 | -------------------------------------------------------------------------------- /files/fez.gitignore: -------------------------------------------------------------------------------- 1 | CSV_XS* 2 | xx* 3 | test-x.pl 4 | tmp/ 5 | sandbox/cover_db* 6 | sandbox/i-ttt* 7 | sandbox/parse-*.png 8 | sandbox/print-*.png 9 | sandbox/rfc7111.odt 10 | sandbox/test.* 11 | profile*.html 12 | Text-CSV*.tgz 13 | Text-CSV*.tar.gz 14 | 15 | # And for CSV6 16 | t-old/* 17 | xt/??_* 18 | ?.pl 19 | logotype/comma* 20 | .precomp 21 | lib/.precomp 22 | *.class 23 | *.jar 24 | csv-c 25 | csv-cc 26 | csv-go 27 | rust*/target 28 | .panda-work/* 29 | 30 | # Re-enable parts later 31 | sandbox/ 32 | *~ 33 | 34 | # Comma stuff ignored 35 | .idea/ 36 | 37 | # not needed for fez distro 38 | .aspell.local.pws 39 | .exrc 40 | .whitesource 41 | 43-1.t 42 | 43-2.t 43 | 43-4.t 44 | 43_binary.t 45 | 88.t 46 | CONTRIBUTING.md 47 | csv-julia.jl 48 | csv-lua.lua 49 | csv-php.php 50 | csv-python2.py 51 | csv-python3.py 52 | csv-R.R 53 | csv-ruby.rb 54 | csv-rust-csvrdr 55 | csv-rust-libcsv 56 | csv-rust-qckrdr 57 | csvJava.java 58 | doc/Text-CSV.3 59 | doc/Text-CSV.html 60 | doc/Text-CSV.man 61 | doc/Text-CSV.md 62 | doc/Text-CSV.pdf 63 | doc/Text-CSV.pod 64 | logotype/logo_32x32.png 65 | make-dist 66 | Makefile 67 | NLPW-2015/.exrc 68 | NLPW-2015/001-cope.txt 69 | NLPW-2015/005-slang.txt 70 | NLPW-2015/010-rakudo.txt 71 | NLPW-2015/015-irc.txt 72 | NLPW-2015/018-debug.txt 73 | NLPW-2015/020-bugs.txt 74 | NLPW-2015/021-bugs.txt 75 | NLPW-2015/022-bugs.txt 76 | NLPW-2015/023-bugs.txt 77 | NLPW-2015/030-state.txt 78 | NLPW-2015/032-grammar.txt 79 | NLPW-2015/035-chunks.txt 80 | NLPW-2015/040-test.txt 81 | NLPW-2015/041-speed.txt 82 | NLPW-2015/050-meta.txt 83 | NLPW-2015/051-meta.txt 84 | NLPW-2015/060-ref.txt 85 | NLPW-2015/070-types.txt 86 | NLPW-2015/071-defaults.txt 87 | NLPW-2015/072-init.txt 88 | NLPW-2015/073-check.txt 89 | NLPW-2015/074-build.txt 90 | NLPW-2015/080-errors.txt 91 | NLPW-2015/081-errors.txt 92 | NLPW-2015/090-hooks.txt 93 | NLPW-2015/110-multi.txt 94 | NLPW-2015/111-multi.txt 95 | NLPW-2015/index 96 | Notes 97 | p6 98 | prove6 99 | README.speed 100 | reasons.txt 101 | rust-csvreader/Cargo.lock 102 | rust-csvreader/Cargo.toml 103 | rust-csvreader/src/csvreader.rs 104 | rust-libcsv/Cargo.lock 105 | rust-libcsv/Cargo.toml 106 | rust-libcsv/src/main.rs 107 | rust-quick-reader/Cargo.lock 108 | rust-quick-reader/Cargo.toml 109 | rust-quick-reader/src/quick-reader.rs 110 | test.sh 111 | test.tsv 112 | TODO 113 | 114 | 115 | # Random stuff that gets packed 116 | inst/ 117 | sdist/ 118 | *.tgz 119 | test.* 120 | opera* 121 | huc.raku 122 | csv-npm*.js 123 | gitignore 124 | crnl.csv 125 | -------------------------------------------------------------------------------- /nc-c.pl: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | use NativeCall; 6 | 7 | my class CSV-Parser is repr("CStruct") { 8 | has int32 $.pstate = 0; # Parser state 9 | has int32 $.quoted; # Is the current field a quoted field? 10 | has int64 $.spaces; # Number of continious spaces after quote or in a non-quoted field 11 | has Pointer[uint8] $.entry_buf; # Entry buffer 12 | has int64 $.entry_pos; # Current position in entry_buf (and current size of entry) 13 | has int64 $.entry_size; # Size of entry buffer 14 | has int32 $.status; # Operation status 15 | has uint8 $.options; 16 | has uint8 $.quote_char; 17 | has uint8 $.delim_char; 18 | has Pointer[int32] $.is_space; 19 | has Pointer[int32] $.is_term; 20 | has int64 $.blk_size; 21 | has Pointer[void] $.malloc_func; 22 | has Pointer[void] $.realloc_func; 23 | has Pointer[void] $.free_func; 24 | } 25 | 26 | # int csv_init (struct csv_parser *p, unsigned char options); 27 | sub csv_init (CSV-Parser, uint8) returns int32 is native("csv3") { * } 28 | 29 | # size_t csv_parse (struct csv_parser *p, const void *s, size_t len, 30 | # void (*cb1)(void *, size_t, void *), void (*cb2)(int, void *), 31 | # void *data); 32 | sub csv_parse (CSV-Parser, Str, int64, 33 | &cb1 (Str, int64, int64 is rw), 34 | &cb2 (int64, int64 is rw), 35 | int64 is rw) returns int64 is native("csv3") { * } 36 | 37 | # void csv_free(struct csv_parser *p); 38 | sub csv_free (CSV-Parser) is native("csv3") { * } 39 | 40 | # const int READ_SZ = 1024 * 1024; 41 | my $READ-SZ = 1024 * 1024; 42 | 43 | my $i = 0; 44 | # void field_count (void* str, size_t str_len, void* data) { 45 | sub field-count (Str $buf, int64 $str-len, int64 $data is rw) { 46 | # int* count = (int*)data; 47 | # *count += 1; 48 | say $i++; 49 | } 50 | 51 | # int main (int argc, char* argv[]) { 52 | # struct csv_parser parser = {0}; 53 | my $parser = CSV-Parser.new; 54 | 55 | # csv_init (&parser, CSV_APPEND_NULL); 56 | csv_init ($parser, 0); 57 | 58 | # char *buf = (char*)malloc (READ_SZ); 59 | # size_t buflen = READ_SZ; 60 | # int count = 0; 61 | my int64 $count = 0; 62 | 63 | # while ((buflen = read (0, buf, READ_SZ)) > 0) { 64 | while (my $blob = $*IN.read ($READ-SZ)) { 65 | 66 | # csv_parse (&parser, buf, buflen, field_count, 0, &count); 67 | csv_parse ($parser, $blob.decode, $READ-SZ, &field-count, Pointer, $count); 68 | } 69 | 70 | # printf ("%d\n", count); 71 | say $count; 72 | 73 | # free (buf); 74 | # csv_free (&parser); 75 | csv_free ($parser); 76 | 77 | # return EXIT_SUCCESS; 78 | # } 79 | -------------------------------------------------------------------------------- /t/16_methods.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | # Test all methods that were defined as sub in XS and still supported in P6 10 | 11 | ok (my $csv = Text::CSV.new, "new"); 12 | 13 | ok (my $version = $csv.version, "version"); 14 | ok ($version ~~ m{^ <[0..9.-]>+ $}, "CSV-$version"); 15 | 16 | is ($csv.quote_char, '"', "quote_char"); 17 | is ($csv.quote, '"', "quote"); 18 | is ($csv.escape_char, '"', "escape_char"); 19 | is ($csv.sep_char, ",", "sep_char"); 20 | is ($csv.sep, ",", "sep"); 21 | is ($csv.eol, Str, "eol"); 22 | is ($csv.always_quote, False, "always_quote"); 23 | is ($csv.quote_space, True, "quote_space"); 24 | is ($csv.escape_null, False, "escape_null"); 25 | is ($csv.quote_binary, True, "quote_binary"); 26 | is ($csv.binary, True, "binary"); 27 | is ($csv.allow_loose_quotes, False, "allow_loose_quotes"); 28 | is ($csv.allow_loose_escapes, False, "allow_loose_escapes"); 29 | is ($csv.allow_whitespace, False, "allow_whitespace"); 30 | is ($csv.allow_unquoted_escape, False, "allow_unquoted_escape"); 31 | is ($csv.blank_is_undef, False, "blank_is_undef"); 32 | is ($csv.empty_is_undef, False, "empty_is_undef"); 33 | is ($csv.auto_diag, False, "auto_diag"); 34 | is ($csv.keep_meta, False, "keep_meta"); 35 | is ($csv.keep-meta, False, "keep-meta"); 36 | is ($csv.meta, False, "meta"); 37 | is ($csv.diag_verbose, 0, "diag_verbose"); 38 | is ($csv.status, True, "status"); 39 | is ($csv.eof, False, "eof"); 40 | is ($csv.error_diag, "", "error_diag"); 41 | is ($csv.record_number, 0, "record_number"); 42 | is ($csv.string, Str, "string"); 43 | is ($csv.fields.elems, 0, "fields"); 44 | is ($csv.strings.elems, 0, "strings"); 45 | is ($csv.is_quoted (0), False, "is_quoted"); 46 | is ($csv.is_binary (0), False, "is_binary"); 47 | is ($csv.is_missing (0), False, "is_missing"); 48 | is ($csv.combine (), True, "combine"); 49 | is ($csv.parse (""), True, "parse"); 50 | is ($csv.column_names.elems, 0, "column_names"); 51 | 52 | # Done or work-in progress (more tests needed?) 53 | # getline 54 | # getline_hr 55 | # getline_all 56 | # getline_hr_all 57 | # fragment 58 | # callbacks 59 | # sub csv 60 | 61 | # do we really want to support ... 62 | # types 63 | 64 | done-testing; 65 | 66 | =finish 67 | 68 | # Not ported - deprecated 69 | sub decode_utf8 70 | sub verbatim 71 | -------------------------------------------------------------------------------- /rust-libcsv/src/main.rs: -------------------------------------------------------------------------------- 1 | extern crate libc; 2 | extern crate num_traits; 3 | 4 | use std::io::Read; 5 | use num_traits::NumCast; 6 | use std::ptr; 7 | use libc::{size_t, c_void}; 8 | 9 | extern "C" fn field_count(_ : *mut c_void, _ : size_t, data : *mut i64) { 10 | unsafe { 11 | *data = *data + 1; 12 | } 13 | } 14 | 15 | #[repr(C)] 16 | struct CSVParser { 17 | pstate: i64, 18 | quoted: i64, 19 | spaces: size_t, 20 | entry_buf: *mut u8, 21 | entry_po: size_t, 22 | entry_size: size_t, 23 | status: i64, 24 | opts: u8, // was "options" 25 | quote_char: u8, 26 | delim_char: u8, 27 | is_space: fn(u8)-> i64, 28 | is_term: fn(u8) -> i64, 29 | blk_size: size_t, 30 | malloc_func: fn(size_t) -> *mut c_void, 31 | relloc_func: fn(*mut c_void, size_t) -> *mut c_void, 32 | free_func: fn(*mut c_void), 33 | } 34 | 35 | impl CSVParser { 36 | fn new() -> CSVParser{ 37 | unsafe { 38 | return ::std::mem::zeroed(); 39 | } 40 | } 41 | } 42 | 43 | #[link(name = "csv")] 44 | extern { 45 | fn csv_init(parser : *mut CSVParser, opt: u8) -> i64; 46 | fn csv_parse(parser: *mut CSVParser, buf: *mut u8, buflen : size_t, 47 | cb: extern fn(*mut c_void, size_t, *mut i64), 48 | cb2: *const c_void, //cb2: fn(i64, *mut c_void), 49 | data: *mut i64) -> size_t; 50 | fn csv_free(parser: *mut CSVParser); 51 | } 52 | 53 | fn main() { 54 | const CSV_APPEND_NULL : u8 = 8; 55 | const READ_SZ : usize = 1024 * 1024; 56 | 57 | let args : Vec = ::std::env::args().collect(); 58 | if args.len() < 2 { 59 | println!("Usage: csvreader "); 60 | return; 61 | } 62 | let filename = &args[1]; 63 | let path = ::std::path::Path::new(filename); 64 | let mut rdr = ::std::fs::File::open(&path).unwrap(); 65 | 66 | let mut parser = CSVParser::new(); 67 | unsafe { csv_init(&mut parser, CSV_APPEND_NULL); }; 68 | 69 | let mut buf = [0; READ_SZ]; 70 | let mut sum = 0; 71 | loop { 72 | match rdr.read(&mut buf) { 73 | Ok(0) => break, 74 | Ok(nread) => { 75 | let pbuf = buf.as_mut_ptr(); 76 | unsafe { 77 | csv_parse(&mut parser, 78 | pbuf, 79 | NumCast::from(nread).unwrap(), 80 | field_count, 81 | ptr::null::(), 82 | &mut sum); 83 | }; 84 | }, 85 | Err(e) => { 86 | println!("Error reaidng file: {}", e); 87 | return; 88 | } 89 | } 90 | } 91 | unsafe { csv_free(&mut parser); }; 92 | println!("{}", sum); 93 | } 94 | -------------------------------------------------------------------------------- /t/41_null.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Text::CSV; 7 | use Test; 8 | 9 | my @pat = ( 10 | "00", 11 | "\00", 12 | "0\0", 13 | "\0\0", 14 | 15 | "0\n0", 16 | "\0\n0", 17 | "0\n\0", 18 | "\0\n\0", 19 | 20 | "\"0\n0", 21 | "\"\0\n0", 22 | "\"0\n\0", 23 | "\"\0\n\0", 24 | 25 | "\"0\n\"0", 26 | "\"\0\n\"0", 27 | "\"0\n\"\0", 28 | "\"\0\n\"\0", 29 | 30 | "0\n0", 31 | "\0\n0", 32 | "0\n\0", 33 | "\0\n\0", 34 | ); 35 | my %exp; 36 | for @pat -> $pat { 37 | my $x = $pat; 38 | $x ~~ s:g/\0/\\0/; 39 | $x ~~ s:g/\n/\\n/; 40 | %exp{$pat} = $x; 41 | } 42 | my Str @line = ("", Str, "0\n", "", "\0\0\n0"); 43 | 44 | my $csv = Text::CSV.new (eol => "\n", 45 | :binary, :auto_diag, :blank_is_undef, :escape-null, :meta); 46 | 47 | ok ($csv.combine (@line), "combine [ ... ]"); 48 | is ($csv.string, qq{,,"0\n",,""0"0\n0"\n}, "string"); 49 | 50 | my $fh = open "__41test.csv", :w or die "$!"; 51 | 52 | for @pat -> $pat { 53 | ok ($csv.print ($fh, $pat), "print %exp{$pat}"); 54 | } 55 | 56 | $csv.always_quote (True); 57 | 58 | ok ($csv.print ($fh, @line), "print [ ... ]"); 59 | 60 | close $fh; 61 | 62 | $fh = open "__41test.csv", :r or die $!; 63 | 64 | for @pat -> $pat { 65 | my @row = $csv.getline ($fh); 66 | ok (@row.elems, "getline %exp{$pat}"); 67 | my $err = $csv.error_diag; 68 | if ($err.error == 2027) { 69 | $fh.get; 70 | next; 71 | } 72 | is (@row[0].text, $pat, "data %exp{$pat}"); 73 | } 74 | 75 | my Str @got = $csv.getline ($fh).map (~*); 76 | is (@got.perl, @line.perl, "read [ ... ]"); 77 | 78 | close $fh; 79 | 80 | unlink "__41test.csv"; 81 | 82 | $csv = Text::CSV.new ( 83 | eol => "\n", 84 | auto_diag => True, 85 | blank_is_undef => True, 86 | quote_null => False, 87 | meta => True, 88 | ); 89 | 90 | ok ($csv.combine (@line), "combine [ ... ]"); 91 | is ($csv.string, qq{,,"0\n",,"\0\0\n0"\n}, "string"); 92 | 93 | $fh = open "__41test.csv", :w or die $!; 94 | 95 | for @pat -> $pat { 96 | ok ($csv.print ($fh, $pat), "print %exp{$pat}"); 97 | } 98 | 99 | $csv.always_quote (True); 100 | 101 | ok ($csv.print ($fh, @line), "print [ ... ]"); 102 | 103 | close $fh; 104 | 105 | $fh = open "__41test.csv", :r or die $!; 106 | 107 | for @pat -> $pat { 108 | my @row = $csv.getline ($fh); 109 | ok (@row.elems, "getline %exp{$pat}"); 110 | is (@row[0].text, $pat, "data %exp{$pat}"); 111 | } 112 | 113 | @got = $csv.getline ($fh).map (~*); 114 | is (@got.perl, @line.perl, "read [ ... ]"); 115 | 116 | close $fh; 117 | 118 | unlink "__41test.csv"; 119 | 120 | done-testing; 121 | -------------------------------------------------------------------------------- /NLPW-2015/041-speed.txt: -------------------------------------------------------------------------------- 1 | sh$ for i in $(seq 1 1000000); do echo 'hello,","," ",world,"!"'; done > /tmp/hello.csv 2 | sh$ time perl csv.pl < /tmp/hello.csv 3 | 4 | sh test.sh 5 | 6 | i686 i686 x68_64 x68_64 x68_64 x68_64 7 | 20141007 20141014 20141105 20141111 20141117 20150102 8 | ------------------ -------- -------- -------- -------- -------- -------- 9 | Text::CSV::Easy_XS 0.022 0.021 0.037 0.018 0.017 0.017 10 | Text::CSV::Easy_PP 0.018 0.022 0.028 0.016 0.016 0.016 11 | Text::CSV_XS 0.038 0.039 0.046 0.039 0.036 0.036 12 | Text::CSV_PP 0.651 0.535 0.533 0.516 0.510 0.510 13 | Pegex::CSV 1.947 1.420 1.387 1.371 1.348 1.356 14 | csv.pl 12.543 8.437 9.152 9.130 8.715 8.249 15 | csv_gram.pl - - - - - 19.501 16 | test.pl 256.985 201.621 71.847 72.221 65.279 59.042 17 | test-t.pl - - - 72.024 65.202 59.869 18 | 19 | 20150109 20150110 20150114 20150204 20150212 20150218 20 | ------------------ -------- -------- -------- -------- -------- -------- 21 | Text::CSV::Easy_XS 0.015 0.015 0.015 0.023 0.016 0.016 22 | Text::CSV::Easy_PP 0.016 0.016 0.017 0.021 0.016 0.016 23 | Text::CSV_XS 0.037 0.038 0.039 0.040 0.039 0.038 24 | Text::CSV_PP 0.520 0.532 0.518 0.518 0.514 0.519 25 | Pegex::CSV 1.360 1.367 1.348 1.382 1.356 1.416 26 | csv.pl 8.571 8.436 8.332 8.314 8.133 8.137 27 | csv-ip5xs - - - 9.223 8.950 9.230 28 | csv-ip5pp - - - - 9.812 9.778 29 | csv_gram.pl 14.107 13.965 14.023 13.860 13.426 13.544 30 | test.pl 40.916 41.197 39.751 39.805 38.733 39.084 31 | test-t.pl 41.407 40.535 38.384 42.080 39.502 38.119 32 | 33 | 20150222 20150223 20150305 20150309 20150331 20150409 34 | ------------------ -------- -------- -------- -------- -------- -------- 35 | Text::CSV::Easy_XS 0.018 0.016 0.017 0.016 0.016 0.016 36 | Text::CSV::Easy_PP 0.017 0.016 0.017 0.017 0.016 0.016 37 | Text::CSV_XS bindc 0.033 0.033 0.033 0.032 0.033 0.032 38 | Text::CSV_XS 0.040 0.037 0.039 0.038 0.038 0.039 39 | Text::CSV_PP 0.519 0.518 0.517 0.514 0.527 0.541 40 | Pegex::CSV 1.357 1.370 1.360 1.384 1.340 1.376 41 | csv.pl 8.442 6.663 7.161 6.917 6.669 7.044 42 | csv-ip5xs 9.425 9.076 13.256 13.128 15.870 16.305 43 | csv-ip5xsio - - - - 15.349 16.115 44 | csv-ip5pp 9.983 9.845 13.973 13.711 16.489 16.925 45 | csv_gram.pl 13.197 12.596 13.474 13.226 13.440 14.114 46 | test.pl 41.505 39.047 40.162 38.633 39.618 39.603 47 | test-t.pl 40.628 37.194 36.658 35.000 35.903 35.822 48 | csv-parser.pl - - - - 389.192 266.180 49 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # ex:se inputtab=tab autotab: 2 | 3 | .PHONY: test test-verbose profile time tt doc 4 | .PRECIOUS: test-t.pl 5 | 6 | test: 7 | @perl bugs.pl -s 8 | podchecker Text-CSV.pod 2>&1 | grep -v WARNING: 9 | pod-spell-check --aspell --ispell Text-CSV.pod 10 | prove -j4 -e 'raku -I. -Ilib' t 11 | 12 | tt: test time html 13 | 14 | test-verbose: lib/Text/CSV.rakumod 15 | raku -I. -Ilib t/10_base.t 16 | raku -I. -Ilib t/12_acc.t 17 | raku -I. -Ilib t/15_flags.t 18 | raku -I. -Ilib t/16_methods.t 19 | raku -I. -Ilib t/20_file.t 20 | raku -I. -Ilib t/21_combine.t 21 | raku -I. -Ilib t/22_print.t 22 | raku -I. -Ilib t/30_field.t 23 | raku -I. -Ilib t/31_row.t 24 | raku -I. -Ilib t/32_getline.t 25 | raku -I. -Ilib t/40_misc.t 26 | raku -I. -Ilib t/41_null.t 27 | raku -I. -Ilib t/45_eol.t 28 | raku -I. -Ilib t/46_eol_si.t 29 | raku -I. -Ilib t/47_comment.t 30 | raku -I. -Ilib t/50_utf8.t 31 | raku -I. -Ilib t/55_combi.t 32 | raku -I. -Ilib t/60_samples.t 33 | raku -I. -Ilib t/65_allow.t 34 | raku -I. -Ilib t/66_formula.t 35 | raku -I. -Ilib t/75_hashref.t 36 | raku -I. -Ilib t/77_getall.t 37 | raku -I. -Ilib t/78_fragment.t 38 | raku -I. -Ilib t/79_callbacks.t 39 | raku -I. -Ilib t/80_diag.t 40 | raku -I. -Ilib t/81_subclass.t 41 | raku -I. -Ilib t/82_subclass.t 42 | raku -I. -Ilib t/85_util.t 43 | raku -I. -Ilib t/90_csv.t 44 | raku -I. -Ilib t/91_csv_cb.t 45 | raku -I. -Ilib t/92_csv_encoding.t 46 | raku -I. -Ilib t/99_meta.t 47 | 48 | profile: 49 | raku -Ilib --profile test-t.pl < /tmp/hello.csv 50 | mv profile-[0-9]* profile.html 51 | 52 | check: 53 | head -5 /tmp/hello.csv | raku -Ilib test-t.pl 54 | 55 | time: 56 | perl time.pl 57 | 58 | dist: 59 | cp files/fez.gitignore .gitignore 60 | -fez upload 61 | cp files/gitignore .gitignore 62 | 63 | test-dist: 64 | cp files/fez.gitignore .gitignore 65 | -fez review 66 | cp files/gitignore .gitignore 67 | 68 | html: 69 | test -d ../Talks/CSVh && pod2html Text-CSV.pod >../Talks/CSVh/pod6.html 2>/dev/null 70 | 71 | doc: doc/Text-CSV.md doc/Text-CSV.pdf doc/Text-CSV.man 72 | doc/Text-CSV.pod: lib/Text/CSV.pod6 73 | perl -ne'/^=(begin|end) pod/ or print' lib/Text/CSV.pod6 > doc/Text-CSV.pod 74 | doc/Text-CSV.md: doc/Text-CSV.pod 75 | pod2markdown < doc/Text-CSV.pod > doc/Text-CSV.md 76 | doc/Text-CSV.html: doc/Text-CSV.pod 77 | pod2html < doc/Text-CSV.pod 2>&1 |\ 78 | grep -v "^Cannot find" > doc/Text-CSV.html 79 | doc/Text-CSV.pdf: doc/Text-CSV.html 80 | html2pdf.pl -f -o doc/Text-CSV.pdf doc/Text-CSV.html 81 | doc/Text-CSV.3: doc/Text-CSV.pod 82 | pod2man < doc/Text-CSV.pod > doc/Text-CSV.3 83 | doc/Text-CSV.man: doc/Text-CSV.3 84 | nroff -mandoc < doc/Text-CSV.3 > doc/Text-CSV.man 85 | 86 | opencsv-2.3.jar: 87 | test -f opencsv-2.3.jar || wget -q http://www.java2s.com/Code/JarDownload/opencsv/opencsv-2.3.jar.zip 88 | test -f opencsv-2.3.jar || unzip opencsv-2.3.jar.zip 89 | -@rm opencsv-2.3.jar.zip 90 | 91 | # If you have more than one java version, just use this as a guide 92 | csv-java.jar: csvJava.java opencsv-2.3.jar 93 | javac -cp opencsv-2.3.jar csvJava.java 94 | zip -9 csv-java.jar csvJava.class 95 | 96 | csv-c: csv-c.c 97 | cc -O3 -s -o csv-c csv-c.c -lcsv3 98 | 99 | csv-cc: csv-cc.cc 100 | g++ -Werror -Wall -pedantic -std=c++11 -s -O2 -fpic -march=native csv-cc.cc -o csv-cc 101 | 102 | csv-go: csv-go.go 103 | go build csv-go.go 104 | -------------------------------------------------------------------------------- /t/75_hashref.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | my $tfn = "_75in.csv"; END { unlink $tfn; } 7 | 8 | use Test; 9 | use Text::CSV; 10 | 11 | my $fh = open $tfn, :w; 12 | $fh.print (q:to/EOC/); 13 | code,name,price,description 14 | 1,Dress,240.00,"Evening gown" 15 | 2,Drinks,82.78,"Drinks" 16 | 3,Sex,-9999.99,"Priceless" 17 | 4,Hackathon,0.00,"QA Hackathon Oslo 2008" 18 | EOC 19 | $fh.close; 20 | 21 | ok (my $csv = Text::CSV.new, "new"); 22 | is ($csv.column_names.elems, 0, "No headers yet"); 23 | 24 | ok ($csv.column_names ("name"), "One single name"); 25 | is ($csv.column_names.elems, 1, "column_names"); 26 | is ($csv.column_names, [< name >], "column_name stored"); 27 | is ($csv.column_names (False).elems, 0, "reset column_names"); 28 | 29 | $fh = open $tfn, :r, :!chomp; 30 | 31 | my $e; 32 | { my $hr = $csv.getline_hr ($fh); 33 | CATCH { default { $e = $_; 1; }} 34 | } 35 | is (+$e, 3002, "3002 - _hr call before column_names"); 36 | like (~$e, rx{^ "EHR" >>}, "3002 - EHR"); 37 | 38 | ok ($csv.column_names (< name code >), "column_names (list)"); 39 | is-deeply ([$csv.column_names], [< name code >], "well set"); 40 | 41 | my @hdr = < code name price description >; 42 | is-deeply ([$csv.getline ($fh, :!meta)], @hdr, "Header still not _hr"); 43 | 44 | ok ($csv.column_names (@hdr), "Set whole header"); 45 | is-deeply ([$csv.column_names], @hdr, "Inspect header"); 46 | 47 | while $csv.getline_hr ($fh) -> %row { 48 | ok (%row{$_}, "Has $_") for @hdr; 49 | like (~%row, rx{^ <[0..9]>+ $}, "Code numeric"); 50 | like (~%row, rx{^ <[A..Z]> <[a..z]>+ $}, "Name Alpha"); 51 | } 52 | 53 | $fh.close; 54 | 55 | $fh = open $tfn, :r, :!chomp; 56 | $csv.colrange ([0, 2]); 57 | is-deeply ($csv.getline_hr ($fh, :!meta), 58 | { :code("code"), :price("price") }, "selection"); 59 | $fh.close; 60 | 61 | unlink $tfn; 62 | 63 | $csv = Text::CSV.new; 64 | $fh = open $tfn, :w; 65 | my %hr = :c_foo("1"), :foo("poison"), :zebra("Of course"); 66 | is ([$csv.column_names (False)], [], "reset column headers"); 67 | ok ($csv.column_names (sort keys %hr), "set column names"); 68 | ok ($csv.eol ("\n"), "set eol for output"); 69 | ok ($csv.print ($fh, $csv.column_names), "print header"); 70 | ok ($csv.print ($fh, %hr), "print (IO, Hash)"); 71 | ok ($csv.print ($fh, {}), "empty print"); 72 | ok ($fh.say (""), "empty line"); 73 | $fh.close; 74 | ok ($csv.keep_meta (True), "keep meta info"); 75 | $fh = open $tfn, :r; 76 | is ([$csv.column_names (False)], [], "reset column headers"); 77 | ok ($csv.column_names ($csv.getline ($fh)), "get column names"); 78 | is-deeply ([$csv.column_names], [< c_foo foo zebra >], "column names"); 79 | my %gth = $csv.getline_hr ($fh); 80 | is-deeply ([ sort keys %gth ], [< c_foo foo zebra >], "keys"); 81 | is-deeply ([%gth».Str], 82 | [%hr], "field values"); 83 | is ($csv.keep_meta (False), False, "reset meta"); 84 | is-deeply ($csv.getline_hr ($fh), 85 | {:c_foo(""), :foo(""), :zebra("")}, "empty record"); 86 | is-deeply ($csv.getline_hr ($fh), {:c_foo("")}, "empty line"); 87 | # TODO: Test for missing columns 2 and 3 88 | $fh.close; 89 | 90 | done-testing; 91 | -------------------------------------------------------------------------------- /examples/csv-check-tuxic: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # csv-check: Check validity of CSV file and report 4 | # (m)'18 Copyright H.M.Brand 2007-2018 5 | 6 | use v6; 7 | use Slang::Tuxic; 8 | use Text::CSV; 9 | 10 | our $VERSION = "6.1"; # 2018-09-06 11 | 12 | sub usage (Bool $err = True, Str :$pn = "csv-check") { 13 | $err and temp $*OUT = $*ERR; 14 | print qq:to/EOU/; 15 | usage: $pn [-s ] [-q ] [-e ] [file.csv] 16 | -s use as seperator char. Auto-detect. Default = ',' 17 | The string "tab" is allowed. 18 | -q use as quotation char. Default = '"' 19 | The string "undef" will disable quotation. 20 | -e use as escape char. Auto-detect. Default = '"' 21 | The string "undef" will disable escapes. 22 | EOU 23 | exit $err; 24 | } # usage 25 | 26 | sub to-str (Str $tag, Str $s) { 27 | my Str $x = $s.perl; 28 | $x ~~ s{^'"' (.*) '"'$} = $0; 29 | $x ~~ s:g{ "\\" '"' } = '"'; 30 | "\e[34m$tag\e[0m = <\e[32m$x\e[0m>"; 31 | } # to-str 32 | 33 | sub MAIN (Bool :$help = False, Str :$s = "", Str :$q = '"', Str :$e = '"', *@f) { 34 | 35 | my Str $pn = $*PROGRAM-NAME; 36 | $pn ~~ s{ .* "/"} = ""; 37 | 38 | $help and usage :$pn, False; 39 | 40 | @f.elems or @f.push: "-"; 41 | for @f -> $fn { 42 | my Str $data = $fn eq "-" ?? $*IN.slurp-rest !! slurp $fn; # Binary NYI 43 | 44 | my Str $eol; 45 | my Str $sep = $s eq "tab" ?? "\t" !! $s; 46 | my Str $quo = $q eq "undef" ?? Str !! $q; 47 | my Str $esc = $e eq "undef" ?? Str !! $e; 48 | 49 | my Bool $bin = False; 50 | my Int $rows = 0; 51 | my %cols; 52 | 53 | unless ($sep) { # No sep char passed, try to auto-detect; 54 | $sep = $data ~~ m/<["\d]> "," <["\d,]>/ ?? "," !! 55 | $data ~~ m/<["\d]> ";" <["\d;]>/ ?? ";" !! 56 | $data ~~ m/<["\d]> "\t" <["\d]> / ?? "\t" !! 57 | # If neither, then for unquoted strings 58 | $data ~~ m/ \w "," <[\w,]> / ?? "," !! 59 | $data ~~ m/ \w ";" <[\w;]> / ?? ";" !! 60 | $data ~~ m/ \w "\t" <[\w]> / ?? "\t" !! ","; 61 | $data ~~ m/(<[\r\n]>+)$/ and $eol = $0.Str; 62 | } 63 | 64 | my $csv = Text::CSV.new (:$sep, :$quo, :$esc, :meta); 65 | my $fh = IO::String.new ($data); 66 | my CSV::Field @row; 67 | while (@row = $csv.getline ($fh)) { 68 | $rows++; 69 | %cols{@row.elems}++; 70 | @row.map (*.is_binary).any and $bin = True; 71 | } 72 | 73 | # Report findings 74 | "Checked \e[35m$fn\e[0m with \e[34m$pn $VERSION\e[0m using \e[34mText::CSV {$csv.version}\e[0m".say; 75 | my $diag = $csv.error-diag; 76 | 77 | if ($diag.error == 2012 && $csv.eof) { 78 | my @coll = %cols.keys.sort: { $^a <=> $^b }; 79 | my $cols = @coll.elems == 1 ?? @coll[0] !! "\e[31m({@coll.join (', ')})\e[0m"; 80 | say "OK: rows: \e[32m$rows\e[0m, columns: \e[32m$cols\e[0m"; 81 | say " {to-str 'sep', $sep}, {to-str 'quo', $quo}, {to-str 'eol', $eol}, bin = $bin"; 82 | if (@coll.elems > 1) { 83 | "\e[33mWARN: multiple column lengths:\e[0m".say; 84 | for @coll -> $c { 85 | printf " %6d line%s with %4d field%s\n", 86 | %cols{$c}, %cols{$c} == 1 ?? " " !! "s", 87 | $c, $c == 1 ?? "" !! "s"; 88 | } 89 | } 90 | } 91 | else { 92 | $csv.diag-verbose (9); 93 | $csv.error-diag.sink; 94 | } 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /examples/csv-check: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | # csv-check: Check validity of CSV file and report 4 | # (m)'18 Copyright H.M.Brand 2007-2018 5 | 6 | # Check csv-check-tuxic for a version with the original style 7 | 8 | use v6; 9 | use Text::CSV; 10 | 11 | our $VERSION = "6.1-ugly"; # 2018-09-06 12 | 13 | sub usage (Bool $err = True, Str :$pn = "csv-check") { 14 | $err and temp $*OUT = $*ERR; 15 | print qq:to/EOU/; 16 | usage: $pn [-s ] [-q ] [-e ] [file.csv] 17 | -s use as seperator char. Auto-detect. Default = ',' 18 | The string "tab" is allowed. 19 | -q use as quotation char. Default = '"' 20 | The string "undef" will disable quotation. 21 | -e use as escape char. Auto-detect. Default = '"' 22 | The string "undef" will disable escapes. 23 | EOU 24 | exit $err; 25 | } # usage 26 | 27 | sub to-str (Str $tag, Str $s) { 28 | my Str $x = $s.perl; 29 | $x ~~ s{^'"' (.*) '"'$} = $0; 30 | $x ~~ s:g{ "\\" '"' } = '"'; 31 | "\e[34m$tag\e[0m = <\e[32m$x\e[0m>"; 32 | } # to-str 33 | 34 | sub MAIN (Bool :$help = False, Str :$s = "", Str :$q = '"', Str :$e = '"', *@f) { 35 | 36 | my Str $pn = $*PROGRAM-NAME; 37 | $pn ~~ s{ .* "/"} = ""; 38 | 39 | $help and usage :$pn, False; 40 | 41 | @f.elems or @f.push: "-"; 42 | for @f -> $fn { 43 | my Str $data = $fn eq "-" ?? $*IN.slurp-rest !! slurp $fn; # Binary NYI 44 | 45 | my Str $eol; 46 | my Str $sep = $s eq "tab" ?? "\t" !! $s; 47 | my Str $quo = $q eq "undef" ?? Str !! $q; 48 | my Str $esc = $e eq "undef" ?? Str !! $e; 49 | 50 | my Bool $bin = False; 51 | my Int $rows = 0; 52 | my %cols; 53 | 54 | unless ($sep) { # No sep char passed, try to auto-detect; 55 | $sep = $data ~~ m/<["\d]> "," <["\d,]>/ ?? "," !! 56 | $data ~~ m/<["\d]> ";" <["\d;]>/ ?? ";" !! 57 | $data ~~ m/<["\d]> "\t" <["\d]> / ?? "\t" !! 58 | # If neither, then for unquoted strings 59 | $data ~~ m/ \w "," <[\w,]> / ?? "," !! 60 | $data ~~ m/ \w ";" <[\w;]> / ?? ";" !! 61 | $data ~~ m/ \w "\t" <[\w]> / ?? "\t" !! ","; 62 | $data ~~ m/(<[\r\n]>+)$/ and $eol = $0.Str; 63 | } 64 | 65 | my $csv = Text::CSV.new(:$sep, :$quo, :$esc, :meta); 66 | my $fh = IO::String.new($data); 67 | my CSV::Field @row; 68 | while (@row = $csv.getline($fh)) { 69 | $rows++; 70 | %cols{@row.elems}++; 71 | @row.map(*.is_binary).any and $bin = True; 72 | } 73 | 74 | # Report findings 75 | "Checked \e[35m$fn\e[0m with \e[34m$pn $VERSION\e[0m using \e[34mText::CSV {$csv.version}\e[0m".say; 76 | my $diag = $csv.error-diag; 77 | 78 | if ($diag.error == 2012 && $csv.eof) { 79 | my @coll = %cols.keys.sort: { $^a <=> $^b }; 80 | my $cols = @coll.elems == 1 ?? @coll[0] !! "\e[31m({@coll.join(', ')})\e[0m"; 81 | say "OK: rows: \e[32m$rows\e[0m, columns: \e[32m$cols\e[0m"; 82 | say " {to-str 'sep', $sep}, {to-str 'quo', $quo}, {to-str 'eol', $eol}, bin = $bin"; 83 | if (@coll.elems > 1) { 84 | "\e[33mWARN: multiple column lengths:\e[0m".say; 85 | for @coll -> $c { 86 | printf " %6d line%s with %4d field%s\n", 87 | %cols{$c}, %cols{$c} == 1 ?? " " !! "s", 88 | $c, $c == 1 ?? "" !! "s"; 89 | } 90 | } 91 | } 92 | else { 93 | $csv.diag-verbose(9); 94 | $csv.error-diag.sink; 95 | } 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /t/30_field.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my CSV::Field $f .= new; # Undefined 10 | is (?$f, False, "Undefined in Boolean context"); 11 | my $n = +$f; 12 | ok ($n ~~ Num, "Undefined in Numeric context type"); 13 | is ($n.defined, False, "Undefined in Numeric context defined"); 14 | my $s = ~$f; 15 | ok ($s ~~ Str, "Undefined in String context type"); 16 | is ($s.defined, False, "Undefined in String context defined"); 17 | is ($f.gist, "", "Undefined as gist"); 18 | 19 | $f.text = "0"; 20 | $f.analyse (True); 21 | is (?$f, False, "'0' in Boolean context"); 22 | $n = +$f; 23 | is ($n.^name, "Int", "'0' in Numeric context type"); 24 | is ($n.defined, True, "'0' in Numeric context defined"); 25 | is ($n, 0, "'0' in Numeric context value"); 26 | $s = ~$f; 27 | is ($s.^name, "Str", "'0' in String context type"); 28 | is ($s.defined, True, "'0' in String context defined"); 29 | is ($s, "0", "'0' in String context value"); 30 | is ($f.gist, 'qb7m-:"0"', "'0' as gist"); 31 | 32 | $f.text = "1"; # "1" 33 | $f.analyse (True); 34 | is (?$f, True, "'1' in Boolean context"); 35 | $n = +$f; 36 | is ($n.^name, "Int", "'1' in Numeric context type"); 37 | is ($n.defined, True, "'1' in Numeric context defined"); 38 | is ($n, 1, "'1' in Numeric context value"); 39 | $s = ~$f; 40 | is ($s.^name, "Str", "'1' in String context type"); 41 | is ($s.defined, True, "'1' in String context defined"); 42 | is ($s, "1", "'1' in String context value"); 43 | is ($f.gist, 'qb7m-:"1"', "'1' as gist"); 44 | 45 | $f.text = "15"; # "15" 46 | $f.analyse (True); 47 | $f.is_quoted = True; 48 | is (?$f, True, "'15' in Boolean context"); 49 | $n = +$f; 50 | is ($n.^name, "Int", "'15' in Numeric context type"); 51 | is ($n.defined, True, "'15' in Numeric context defined"); 52 | is ($n, 15, "'15' in Numeric context value"); 53 | $s = ~$f; 54 | is ($s.^name, "Str", "'15' in String context type"); 55 | is ($s.defined, True, "'15' in String context defined"); 56 | is ($s, "15", "'15' in String context value"); 57 | is ($f.gist, 'Qb7m-:"15"', "'15' as gist"); 58 | 59 | $f.text = "=1+2"; # "=1+2" 60 | $f.analyse (True); 61 | is (?$f, True, "'=1+2' in Boolean context"); 62 | $n = +$f; 63 | is ($n.^name, "Failure", "'=1+2' in Numeric context type"); 64 | is ($n.defined, False, "'=1+2' in Numeric context defined"); 65 | $s = ~$f; 66 | is ($s.^name, "Str", "'=1+2' in String context type"); 67 | is ($s.defined, True, "'=1+2' in String context defined"); 68 | is ($s, "=1+2", "'=1+2' in String context value"); 69 | is ($f.gist, 'Qb7m=:"=1+2"', "'=1+2' as gist"); 70 | 71 | $f = CSV::Field.new (text => "\x[246e]", :is_quoted); # "CIRCLED NUMBER FIFTEEN" 72 | is (?$f, True, "'\"\x[246e]\"' in Boolean context"); 73 | $n = +$f; 74 | is ($n.^name, "Int", "'\"\x[246e]\"' in Numeric context type"); 75 | is ($n.defined, True, "'\"\x[246e]\"' in Numeric context defined"); 76 | is ($n, 15, "'\"\x[246e]\"' in Numeric context value"); 77 | $s = ~$f; 78 | is ($s.^name, "Str", "'\"\x[246e]\"' in String context type"); 79 | is ($s.defined, True, "'\"\x[246e]\"' in String context defined"); 80 | is ($s, "\x[246e]", "'\"\x[246e]\"' in String context value"); 81 | is ($f.is_binary, True, "'\"\x[246e]\"' in String context binary"); 82 | is ($f.gist, "QB8m-:\"\x[246e]\"", "'\"\x[246e]\"' as gist"); 83 | 84 | done-testing; 85 | -------------------------------------------------------------------------------- /t/55_combi.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my @attrib = "quote_char", "escape_char", "sep_char"; 10 | my @special = '"', "'", ",", ";", "\t", "\\", "~"; 11 | my @input = "", 1, "1", 1.4, "1.4", " - 1,4", "1+2=3", "' ain't it great '", 12 | Str, '"foo"! said the `bär', q{the ~ in "0 \0 this l'ne is \r ; or "'"}; 13 | my $ninput = @input.elems; 14 | my $string = join "=", "", @input.map ({$_//""}), ""; 15 | my %fail; 16 | 17 | ok (1, "-- qc ec sc ac aw"); 18 | 19 | sub combi (*%attr) 20 | { 21 | my $combi = join " ", "--", map { sprintf "%6s", %attr{$_}.perl; }, 22 | @attrib, "always_quote", "allow_whitespace"; 23 | ok (1, $combi); 24 | 25 | my $csv = Text::CSV.new ( 26 | binary => 1, 27 | sep => "\x03", 28 | quo => "\x04", 29 | esc => "\x05", 30 | ); 31 | 32 | # Set the attributes and check failure 33 | my %state; 34 | for sort keys %attr -> $attr { 35 | my $v = %attr{$attr}; 36 | { $csv."$attr"(%attr{$attr}); 37 | 38 | CATCH { default { 39 | %state{.error} ||= .message; 40 | }} 41 | }; 42 | } 43 | if (%attr eq %attr || 44 | %attr eq %attr) { 45 | ok (%state{1001}.defined, "Illegal combo sep == quo || sep == esc"); 46 | is (%state{1001}, "INI - separator is equal to quote- or escape sequence", "Illegal combo 1001"); 47 | #%state{1001} ~~ m{"separator is equal to"} or warn "HELP"; 48 | #%state{1001} ~~ m{"separator is equal to"} or die %state{1001}; 49 | } 50 | else { 51 | ok (!%state{1001}.defined, "No char conflict"); 52 | } 53 | if (!%state{1001}.defined and 54 | %attr ~~ m/[\r\n]/ || 55 | %attr ~~ m/[\r\n]/ || 56 | %attr ~~ m/[\r\n]/ 57 | ) { 58 | ok (%state{1003}.defined, "Special contains eol"); 59 | ok (%state{1003} ~~ rx{"in main attr not"}, "Illegal combo (1003)"); 60 | } 61 | if (%attr and 62 | %attr ~~ m/^[ \t]/ || 63 | %attr ~~ m/^[ \t]/ 64 | ) { 65 | #diag (join " -> ** " => $combi, join ", " => sort %state); 66 | ok (%state{1002}.defined, "Illegal combo under allow_whitespace"); 67 | ok (%state{1002} ~~ rx{"allow_whitespace with"}, "Illegal combo (1002)"); 68 | } 69 | %state and return; 70 | 71 | # Check success 72 | is ($csv."$_"(), %attr{$_}, "check $_") for sort keys %attr; 73 | 74 | my $ret = $csv.combine (@input); 75 | 76 | ok ($ret, "combine"); 77 | ok (my $str = $csv.string, "string"); 78 | #"# @$?LINE ‹$str›".say; 79 | 80 | $csv.auto-diag (True); 81 | ok (my $ok = $csv.parse ($str), "parse"); 82 | 83 | unless ($ok) { 84 | $csv.error_diag.perl.say; 85 | %fail{$combi} = $csv.error_input; 86 | return; 87 | } 88 | 89 | my @ret = $csv.fields; 90 | ok (@ret.elems, "fields"); 91 | unless (@ret.elems) { 92 | %fail{$combi} = $csv.error_input; 93 | return; 94 | } 95 | 96 | is (@ret.elems, $ninput, "$ninput fields"); 97 | unless (@ret.elems == $ninput) { 98 | %fail{'$#fields'}{$combi} = $str; 99 | skip "# fields failed", 1; 100 | } 101 | 102 | $ret = join "=", "", @ret.map ({$_.text.Str}), ""; 103 | is ($ret, $string, "content"); 104 | } # combi 105 | 106 | for ( False, True ) -> $aw { 107 | for ( False, True ) -> $aq { 108 | for ( flat @special ) -> $qc { 109 | for ( flat @special, "+" ) -> $ec { 110 | for ( flat @special, "\0" ) -> $sc { 111 | combi ( 112 | sep_char => $sc, 113 | quote_char => $qc, 114 | escape_char => $ec, 115 | always_quote => $aq, 116 | allow_whitespace => $aw, 117 | ); 118 | } 119 | } 120 | } 121 | } 122 | } 123 | 124 | done-testing; 125 | -------------------------------------------------------------------------------- /t/85_util.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | use Text::IO::String; 9 | 10 | my $csv = Text::CSV.new; 11 | 12 | is ($csv.sep, ",", "Sep = ,"); 13 | 14 | for < , ; > -> $sep { 15 | my Str $data = "bAr,foo\n1,2\n3,4,5\n"; 16 | $data ~~ s:g{ "," } = $sep; 17 | 18 | $csv.column-names (False); 19 | { my $fh = Text::IO::String.new: $data; 20 | ok (my $slf = $csv.header ($fh), "header"); 21 | is ($slf, $csv, "Return self"); 22 | is ($csv.sep, $sep, "Sep = $sep"); 23 | is-deeply ([ $csv.column-names ], [< bar foo >], "headers"); 24 | is-deeply ($csv.getline ($fh), ["1", "2"], "Line 1"); 25 | is-deeply ($csv.getline ($fh), ["3", "4", "5"], "Line 2"); 26 | } 27 | 28 | $csv.column-names (False); 29 | { my $fh = Text::IO::String.new: $data; 30 | ok (my $slf = $csv.header ($fh), "header"); 31 | is ($slf, $csv, "Return self"); 32 | is ($csv.sep, $sep, "Sep = $sep"); 33 | is-deeply ([ $csv.column-names ], [< bar foo >], "headers"); 34 | is-deeply ($csv.getline_hr ($fh), { bar => "1", foo => "2" }, "Line 1"); 35 | is-deeply ($csv.getline_hr ($fh), { bar => "3", foo => "4" }, "Line 2"); 36 | } 37 | } 38 | 39 | my $sep-set = [ "\t", "|", ",", ";" ]; 40 | for ",", ";", "|", "\t" -> $sep { 41 | my Str $data = "bAr,foo\n1,2\n3,4,5\n"; 42 | $data ~~ s:g{ "," } = $sep; 43 | 44 | $csv.column-names (False); 45 | { my $fh = Text::IO::String.new: $data; 46 | ok (my $slf = $csv.header ($fh, :$sep-set), "header with specific sep set"); 47 | is ($slf, $csv, "Return self"); 48 | is ($csv.sep, $sep, "Sep = $sep"); 49 | is-deeply ([ $csv.column-names ], [< bar foo >], "headers"); 50 | is-deeply ($csv.getline ($fh), ["1", "2"], "Line 1"); 51 | is-deeply ($csv.getline ($fh), ["3", "4", "5"], "Line 2"); 52 | } 53 | 54 | $csv.column-names (False); 55 | { my $fh = Text::IO::String.new: $data; 56 | ok (my $slf = $csv.header ($fh, :$sep-set), "header with specific sep set"); 57 | is ($slf, $csv, "Return self"); 58 | is ($csv.sep, $sep, "Sep = $sep"); 59 | is-deeply ([ $csv.column-names ], [< bar foo >], "headers"); 60 | is-deeply ($csv.getline_hr ($fh), { bar => "1", foo => "2" }, "Line 1"); 61 | is-deeply ($csv.getline_hr ($fh), { bar => "3", foo => "4" }, "Line 2"); 62 | } 63 | } 64 | 65 | for 1010, "", 66 | 1011, "a,b;c,d", 67 | 1012, "a,,b", 68 | 1013, "a,a,b", 69 | 2027, "a,\"b\nc\",d" 70 | -> $err, $data { 71 | my $fh = Text::IO::String.new: $data; 72 | my $e; 73 | my $self; 74 | { $self = $csv.header ($fh); 75 | CATCH { default { $e = $_; "" }} 76 | } 77 | is ($self, Any, "FAIL for {$data.perl}"); 78 | is ($e.error, $err, "Error code $err"); 79 | $err == 1013 and ok ($e.message.contains (< a(2)>), "Duplicate fields are reported"); 80 | } 81 | { my $fh = Text::IO::String.new: "bar,bAr,bAR,BAR\n1,2,3,4"; 82 | $csv.column-names (False); 83 | ok ($csv.header ($fh, munge-column-names => "none"), "non-unique unfolded headers"); 84 | is-deeply ([ $csv.column-names ], [< bar bAr bAR BAR >], "Headers"); 85 | } 86 | 87 | for < , ; > -> $sep { 88 | my Str $data = "bAr,foo\n1,2\n3,4,5\n"; 89 | $data ~~ s:g{ "," } = $sep; 90 | 91 | $csv.column-names (False); 92 | { my $fh = Text::IO::String.new: $data; 93 | ok (my $slf = $csv.header ($fh, :!set-column-names), "Header without column setting"); 94 | is ($slf, $csv, "Return self"); 95 | is ($csv.sep, $sep, "Sep = $sep"); 96 | is-deeply ([ $csv.column-names ], [], "headers"); 97 | is-deeply ($csv.getline ($fh), ["1", "2"], "Line 1"); 98 | is-deeply ($csv.getline ($fh), ["3", "4", "5"], "Line 2"); 99 | } 100 | } 101 | 102 | my $n = 0; 103 | for Str, "bar", "fc", "bar", "lc", "bar", "uc", "BAR", "none", "bAr", 104 | { "column_{$n++}" }, "column_0" -> $munge-column-names, $hdr { 105 | my Str $data = "bAr,foo\n1,2\n3,4,5\n"; 106 | 107 | $csv.column-names (False); 108 | my $fh = Text::IO::String.new: $data; 109 | ok (my $slf = $csv.header ($fh, :$munge-column-names), "header with fold {$munge-column-names.perl}"); 110 | is ($csv.column-names[0], $hdr, "folded header to $hdr"); 111 | } 112 | 113 | done-testing; 114 | -------------------------------------------------------------------------------- /csv_gram.pl: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | class Text::CSV { 4 | has Str $.quote_char is rw = '"'; 5 | has Str $.escape_char is rw = '"'; 6 | has Str $.sep_char is rw = ','; 7 | has Str $.eol is rw; # = ($*IN.newline), 8 | has Bool $.always_quote is rw; 9 | has Bool $.quote_space is rw = True; 10 | has Bool $.quote_null is rw = True; 11 | has Bool $.quote_binary is rw = True; 12 | has Bool $.binary is rw; 13 | has Bool $.keep_meta_info is rw; 14 | has Bool $.allow_loose_quotes is rw; 15 | has Bool $.allow_loose_escapes is rw; 16 | has Bool $.allow_whitespace is rw; 17 | has Bool $.blank_is_undef is rw; 18 | has Bool $.empty_is_undef is rw; 19 | has Bool $.verbatim is rw; 20 | has Bool $.auto_diag is rw; 21 | 22 | class CSV_Actions { 23 | method fields($/){ 24 | make $>>>>.Str; 25 | } 26 | method line($/){ 27 | make $.ast; 28 | } 29 | } 30 | method compose { 31 | my $q = $!quote_space; 32 | my $s = $!sep_char; 33 | my $e = $!escape_char; 34 | my $l = $!eol; 35 | grammar { 36 | token lines { * } 37 | token line { } 38 | token fields { * % } 39 | token field { : $= | $= } 40 | token value { [ <-separator> & <-quote> & <-lineend> ] * } 41 | token quotedvalue { <-quote> * } 42 | token separator { "$s" } 43 | token quote { "$q" } 44 | token escape { "$e" } 45 | token lineend { $l } 46 | } 47 | } 48 | has $!gram = self.compose();#.new; 49 | has $!ast; 50 | 51 | method parse(Str:D $line){ 52 | #say nqp::objectid($!gram); 53 | $!ast = $!gram.parse($line, :rule, :actions(CSV_Actions)).ast; 54 | } 55 | 56 | method getline(){ 57 | $!ast; 58 | } 59 | } 60 | 61 | sub MAIN( 62 | Str :$quote_char = '"', 63 | Str :$escape_char = '"', 64 | Str :$sep_char = ',', 65 | Str :$eol, # = ($*IN.newline), 66 | Bool :$always_quote, 67 | Bool :$quote_space = True, 68 | Bool :$quote_null = True, 69 | Bool :$quote_binary = True, 70 | Bool :$binary, 71 | Bool :$keep_meta_info, 72 | Bool :$allow_loose_quotes, 73 | Bool :$allow_loose_escapes, 74 | Bool :$allow_whitespace, 75 | Bool :$blank_is_undef, 76 | Bool :$empty_is_undef, 77 | Bool :$verbatim, 78 | Bool :$auto_diag, 79 | ) { 80 | 81 | my $csv_parser = Text::CSV.new 82 | ## :$quote_char 83 | ## :$escape_char 84 | ## :$sep_char 85 | ## :$eol 86 | ## :$always_quote 87 | ## :$quote_space 88 | ## :$quote_null 89 | ## :$quote_binary 90 | ## :$binary 91 | ## :$keep_meta_info 92 | ## :$allow_loose_quotes 93 | ## :$allow_loose_escapes 94 | ## :$allow_whitespace 95 | ## :$blank_is_undef 96 | ## :$empty_is_undef 97 | ## :$verbatim 98 | ## :$auto_diag 99 | ; 100 | 101 | $csv_parser.parse(q/ab,cde,"q",/); 102 | say $csv_parser.getline().perl; 103 | 104 | my $csv_parser2 = Text::CSV.new :sep_char ; 105 | 106 | $csv_parser2.parse(q/ab,cde"q"e/); 107 | say $csv_parser2.getline().perl; 108 | 109 | $csv_parser.parse(q/ab,cde,"q",/); 110 | say $csv_parser.getline().perl; 111 | 112 | my $csv_parser3 = Text::CSV.new :sep_char<,> ; 113 | 114 | $csv_parser2.parse(q/ab,cde"q"e/); 115 | say $csv_parser2.getline().perl; 116 | 117 | #$csv_parser.parse(q/ab,cde"q"eaa"aaarghh/); 118 | #$csv_parser.parse(q/ab,cde"q"e"aaarghh/); 119 | ## $csv_parser.sep_char=','; 120 | my $sum = 0; 121 | for lines() :eager { 122 | $csv_parser.parse($_); 123 | my $r = $csv_parser.getline(); 124 | # say $r.perl; 125 | # say +$r; 126 | $sum += +$r; 127 | #last; 128 | } 129 | say $sum; 130 | } 131 | -------------------------------------------------------------------------------- /t/50_utf8.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | # Test rejection of binary whilst accepting UTF-8 10 | my $csv = Text::CSV.new (:always_quote, :!binary, :meta); 11 | 12 | # Special characters to check: 13 | # 0A = \n 2C = , 20 = 22 = " 14 | # 0D = \r 3B = ; 15 | my @special = ( 16 | # Space-like characters 17 | [ "\x[0000A0]", "U+0000A0 NO-BREAK SPACE" ], 18 | [ "\x[00200B]", "U+00200B ZERO WIDTH SPACE" ], 19 | # Some characters with possible problems in the code point 20 | [ "\x[000122]", "U+000122 LATIN CAPITAL LETTER G WITH CEDILLA" ], 21 | [ "\x[002C22]", "U+002C22 GLAGOLITIC CAPITAL LETTER SPIDERY HA" ], 22 | [ "\x[000A2C]", "U+000A2C GURMUKHI LETTER BA" ], 23 | [ "\x[000E2C]", "U+000E2C THAI CHARACTER LO CHULA" ], 24 | [ "\x[010A2C]", "U+010A2C KHAROSHTHI LETTER VA" ], 25 | # Characters with possible problems in the encoded representation 26 | # Should not be possible. ASCII is coded in 000..127, all other 27 | # characters in 128..255 28 | ); 29 | 30 | my $q = $csv.quo; 31 | for @special -> @test { 32 | (my $u, my $msg) = @test; 33 | my Str @in = ("", " ", $u, ""); 34 | my $exp = join ",", @in.map ($q~*~$q); 35 | ok ($csv.combine (@in), "combine $msg"); 36 | 37 | my $str = $csv.string; 38 | is ($str.perl, $exp.perl, "string $msg"); 39 | 40 | ok ($csv.parse ($str), "parse $msg"); 41 | my @out = $csv.fields; 42 | is (@in.elems, @out.elems, "fields $msg"); 43 | is ((@out[$_]//CSV::Field.new).text.perl, @in[$_].perl, "field $_ $msg") for ^@in.elems; 44 | } 45 | 46 | # Test if the UTF8 part is accepted, but the \n is not 47 | is ($csv.parse (qq{"\x[0123]\n\x[20ac]"}), False, "\\n still needs binary"); 48 | is ($csv.binary, False, "bin flag still unset"); 49 | is ($csv.error_diag + 0, 2021, "Error 2021"); 50 | 51 | my $file = "files/utf8.csv"; 52 | SKIP: { 53 | my $fh = open $file, :r; 54 | 55 | ok ((my @row = $csv.getline ($fh)), "read/parse"); 56 | 57 | is (@row[0].is_quoted, True, "First field is quoted"); 58 | is (@row[1].is_quoted, False, "Second field is not quoted"); 59 | is (@row[0].is_binary, True, "First field is binary"); 60 | is (@row[1].is_binary, False, "Second field is not binary"); 61 | 62 | is ($csv.is_quoted (0), True, "First field is quoted"); 63 | is ($csv.is_quoted (1), False, "Second field is not quoted"); 64 | is ($csv.is_binary (0), True, "First field is binary"); 65 | is ($csv.is_binary (1), False, "Second field is not binary"); 66 | 67 | ok (@row[0].is_utf8, "First field is valid utf8"); 68 | 69 | $csv.combine (@row); 70 | ok ($csv.string, "Combined string is valid utf8"); 71 | } 72 | 73 | # Test quote_binary 74 | $csv.always_quote (0); 75 | $csv.quote_space (0); 76 | $csv.quote_binary (0); 77 | ok ($csv.combine (" ", 1, "\x[20ac] "), "Combine"); 78 | is ($csv.string, qq{ ,1,\x[20ac] }, "String 0-0"); 79 | $csv.quote_binary (1); 80 | ok ($csv.combine (" ", 1, "\x[20ac] "), "Combine"); 81 | is ($csv.string, qq{ ,1,\x[20ac] }, "String 0-1"); 82 | 83 | $csv.quote_space (1); 84 | $csv.quote_binary (0); 85 | ok ($csv.combine (" ", 1, "\x[20ac] "), "Combine"); 86 | is ($csv.string, qq{" ",1,"\x[20ac] "}, "String 1-0"); 87 | ok ($csv.quote_binary (1), "quote binary on"); 88 | ok ($csv.combine (" ", 1, "\x[20ac] "), "Combine"); 89 | is ($csv.string, qq{" ",1,"\x[20ac] "}, "String 1-1"); 90 | 91 | my $fh = open "_50test.csv", :w; 92 | $fh.print ("euro\n\x[20ac]\neuro\n"); 93 | $fh.close; 94 | $fh = open "_50test.csv", :r; 95 | 96 | ok ($csv.auto_diag (1), "auto diag"); 97 | ok ($csv.binary (1), "set binary"); 98 | ok ((my @row = $csv.getline ($fh)), "parse"); 99 | is ($csv.is_binary (0), False, "not binary"); 100 | is (@row[0].text, "euro", "euro"); 101 | is ($csv.is_utf8 (1), False, "not utf8"); 102 | ok ((@row = $csv.getline ($fh)), "parse"); 103 | is ($csv.is_binary (0), True, "is binary"); 104 | is (@row[0].text, "\x[20ac]", "euro"); 105 | is (@row[0].is_utf8, True, "is utf8"); 106 | ok ((@row = $csv.getline ($fh)), "parse"); 107 | is ($csv.is_binary (0), False, "not binary"); 108 | is (@row[0].text, "euro", "euro"); 109 | is (@row[0].is_utf8, False, "not utf8"); 110 | $fh.close; 111 | unlink "_50test.csv"; 112 | 113 | done-testing; 114 | -------------------------------------------------------------------------------- /t/91_csv_cb.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | 5 | use Test; 6 | use Text::CSV; 7 | use Slang::Tuxic; 8 | 9 | my $file = "_91test.csv"; END { unlink $file } 10 | my $data = 11 | "foo,bar,baz\n"~ 12 | "1,2,3\n"~ 13 | "2,a b,\n"; 14 | my $fh = open $file, :w; 15 | $fh.print ($data); 16 | $fh.close; 17 | 18 | my @aoa = 19 | [< foo bar baz >], 20 | [ "1", "2", "3" ], 21 | [ "2", "a b", "" ]; 22 | my @aoh = 23 | { foo => "1", bar => "2", baz => "3" }, 24 | { foo => "2", bar => "a b", baz => "" }; 25 | 26 | sub Empty (CSV::Row $r) {} 27 | 28 | for (< after_in on_in before_out >) -> $t { 29 | is-deeply (csv (in => $file, |( $t => &Empty )), @aoa, "callback $t on AOA with empty sub"); 30 | is-deeply (csv (in => $file, callbacks => { $t => &Empty }), @aoa, "callback $t on AOA with empty sub"); 31 | } 32 | is-deeply (csv (in => $file, after_in => &Empty, 33 | callbacks => { on_in => &Empty }), @aoa, "callback after_in and on_in on AOA"); 34 | 35 | for (< after_in on_in before_out >) -> $t { 36 | is-deeply (csv (in => $file, headers => "auto", |( $t => &Empty )), @aoh, "callback $t on AOH with empty sub"); 37 | is-deeply (csv (in => $file, headers => "auto", callbacks => { $t => &Empty }), @aoh, "callback $t on AOH with empty sub"); 38 | } 39 | is-deeply (csv (in => $file, headers => "auto", after_in => &Empty, 40 | callbacks => { on_in => &Empty }), @aoh, "callback after_in and on_in on AOH"); 41 | 42 | sub Push (CSV::Row $r) { $r.push: "A"; } 43 | 44 | is-deeply (csv (in => $file, after_in => &Push), [ 45 | [< foo bar baz A >], 46 | [ "1", "2", "3", "A" ], 47 | [ "2", "a b", "", "A" ], 48 | ], "AOA with after_in callback function"); 49 | 50 | sub Change (CSV::Row $r) { $r.csv.column-names and $r.text = "A"; } 51 | 52 | is-deeply (csv (in => $file, headers => "auto", after_in => &Change), [ 53 | { foo => "1", bar => "2", baz => "A" }, 54 | { foo => "2", bar => "a b", baz => "A" }, 55 | ], "AOH with after_in callback function"); 56 | 57 | is-deeply (csv (in => $file, filter => { $^r[1] ~~ /a/ }), [ 58 | [< foo bar baz >], 59 | [ "2", "a b", "" ]; 60 | ], "AOH with filter on col 2"); 61 | 62 | is-deeply (csv (in => $file, filter => { %^r ~~ /a/ }), [ 63 | { foo => "2", bar => "a b", baz => "" }, 64 | ], "AOH with filter on col bar"); 65 | 66 | is-deeply (csv (in => $file, headers => "lc"), [ 67 | { foo => "1", bar => "2", baz => "3" }, 68 | { foo => "2", bar => "a b", baz => "" }; 69 | ], "AOH with lc headers"); 70 | 71 | is-deeply (csv (in => $file, headers => "uc"), [ 72 | { FOO => "1", BAR => "2", BAZ => "3" }, 73 | { FOO => "2", BAR => "a b", BAZ => "" }; 74 | ], "AOH with uc headers"); 75 | 76 | is-deeply (csv (in => $file, headers => { tclc ($^a) } ), [ 77 | { Foo => "1", Bar => "2", Baz => "3" }, 78 | { Foo => "2", Bar => "a b", Baz => "" }; 79 | ], "AOH with tclc headers"); 80 | 81 | is-deeply (csv (in => $file, headers => { $^a.substr (0, 1).lc ~ $^a.substr (1).uc } ), [ 82 | { fOO => "1", bAR => "2", bAZ => "3" }, 83 | { fOO => "2", bAR => "a b", bAZ => "" }; 84 | ], "AOH with lcfirst/uc headers"); 85 | 86 | my %munge = :foo; 87 | is-deeply (csv (in => $file, headers => %munge), [ 88 | { mars => "1", bar => "2", baz => "3" }, 89 | { mars => "2", bar => "a b", baz => "" }; 90 | ], "AOH with munged headers"); 91 | 92 | is-deeply (csv (in => $file, key => "foo"), { 93 | "1" => { foo => "1", bar => "2", baz => "3" }, 94 | "2" => { foo => "2", bar => "a b", baz => "" }, 95 | }, "Simple key"); 96 | 97 | is-deeply (csv (in => $file, key => "foo", on_in => -> CSV::Row $r { 98 | $r.csv.column_names and $r.text = "" }), { 99 | "1" => { foo => "1", bar => "", baz => "3" }, 100 | "2" => { foo => "2", bar => "", baz => "" }, 101 | }, "Simple key with in-line on_in"); 102 | 103 | is-deeply (csv (in => $file, key => "foo", on_in => { 104 | $^r.csv.column_names and $^r.text = "" }), { 105 | "1" => { foo => "1", bar => "", baz => "3" }, 106 | "2" => { foo => "2", bar => "", baz => "" }, 107 | }, "Simple key with in-line typeless on_in"); 108 | 109 | is-deeply (csv (in => $file, key => "foo", on_in => { $^r = "" }), { 110 | "1" => { foo => "1", bar => "", baz => "3" }, 111 | "2" => { foo => "2", bar => "", baz => "" }, 112 | }, "Simple key with in-line on_in with direct key assignment"); 113 | 114 | is-deeply (csv (in => $file, on_in => { $^r[1] = "x" }), [ 115 | [< foo x baz >], 116 | [ "1", "x", "3" ], 117 | [ "2", "x", "" ], 118 | ], "on-in with direct index assignment"); 119 | 120 | done-testing; 121 | -------------------------------------------------------------------------------- /t/77_getall.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | use Text::IO::String; 9 | 10 | my $csv = Text::CSV.new; 11 | my $tfn = "_77test.csv"; 12 | 13 | my @testlist = ( 14 | [ "1", "a", "\x01", "A" ], 15 | [ "2", "b", "\x02", "B" ], 16 | [ "3", "c", "\x03", "C" ], 17 | [ "4", "d", "\x04", "D" ], 18 | ); 19 | 20 | my @list; 21 | 22 | sub do_tests (Sub $sub) { 23 | $sub.(@list); 24 | $sub.(@list, 0); 25 | $sub.(@list[2,3], 2); 26 | $sub.([], 0, 0); 27 | $sub.(@list, 0, 10); 28 | $sub.(@list[0,1], 0, 2); 29 | $sub.(@list[1,2], 1, 2); 30 | $sub.(@list[1,2,3], -3); 31 | $sub.([], -3, 0); 32 | $sub.(@list[1,2], -3, 2); 33 | $sub.(@list[1,2,3], -3, 3); 34 | } # do_tests 35 | 36 | for ("\n", "\r") -> $eol { 37 | 38 | @list = @testlist; 39 | 40 | { ok (my $csv = Text::CSV.new (eol => $eol), "csv out EOL "~$eol.perl); 41 | my $fh = open $tfn, :w or die "$tfn: $!"; 42 | ok ($csv.print ($fh, $_), "write "~$_.perl) for @list; 43 | $fh.close; 44 | } 45 | 46 | { ok (my $csv = Text::CSV.new (eol => $eol), "csv out EOL "~$eol.perl); 47 | 48 | do_tests (anon sub (@expect, *@args) { 49 | 50 | my @exp = @expect; # Needed as Parcels are not Arrays $(1,2) vs [1,2] 51 | my $s_args = @args.join (", "); 52 | 53 | my $fh = open $tfn, :r or die "$tfn: $!"; 54 | my @f = $csv.getline_all ($fh, |@args); 55 | is-deeply (@f, @exp, "getline_all ($s_args)"); 56 | $fh.close; 57 | 58 | $fh = open $tfn, :r or die "$tfn: $!"; 59 | @f = $csv.getline_all ($fh, |@args, :!meta); 60 | is-deeply (@f, @exp, "getline_all ($s_args, no-meta)"); 61 | $fh.close; 62 | }); 63 | 64 | my $fh = open $tfn, :r or die "$tfn: $!"; 65 | ok ($csv.colrange ("1;4"), "ColRange 1;4"); 66 | ok ($csv.rowrange ("2;4"), "RowRange 2;4"); 67 | is-deeply ($csv.getline_all ($fh), 68 | [["2","B"],["4","D"]], "Selection"); 69 | } 70 | 71 | unlink $tfn; 72 | } 73 | 74 | my Str @hdr = < A B C D >; 75 | sub expect_hr (@expect) { 76 | my @expect_hr; 77 | for @expect -> @r { 78 | my %h = @hdr Z=> @r; 79 | @expect_hr.push: $%h; 80 | } 81 | return @expect_hr; 82 | } 83 | 84 | for ("\n", "\r") -> $eol { 85 | 86 | @list = @testlist; 87 | my $hdr = [ @hdr ]; 88 | 89 | { ok (my $csv = Text::CSV.new (eol => $eol), "csv out EOL "~$eol.perl); 90 | my $fh = open $tfn, :w or die "$tfn: $!"; 91 | ok ($csv.print ($fh, $_), "write "~$_.perl) for @list; 92 | $fh.close; 93 | } 94 | 95 | { ok (my $csv = Text::CSV.new (eol => $eol), "csv out EOL "~$eol.perl); 96 | 97 | $csv.column_names (@hdr); 98 | 99 | my Bool $meta = False; 100 | 101 | do_tests (anon sub (@expect, *@args) { 102 | 103 | my @exp = expect_hr (@expect); 104 | my $s_args = @args.join (", "); 105 | 106 | my $fh = open $tfn, :r or die "$tfn: $!"; 107 | my @f = $csv.getline_hr_all ($fh, :$meta, |@args); 108 | is-deeply (@f, @exp, "getline_hr_all ($s_args)"); 109 | $fh.close; 110 | }); 111 | 112 | my $fh = open $tfn, :r or die "$tfn: $!"; 113 | ok ($csv.colrange ("1;4"), "ColRange 1;4"); 114 | ok ($csv.rowrange ("2;4"), "RowRange 2;4"); 115 | is-deeply ($csv.getline_hr_all ($fh, :$meta), 116 | [{:A("2"), :D("B")},{:A("4"), :D("D")}], "Selection"); 117 | } 118 | 119 | unlink $tfn; 120 | } 121 | 122 | { ok (my $csv = Text::CSV.new, "new for sep="); 123 | my $fh = Text::IO::String.new (qq{sep=;\n"a b";3\n}); 124 | is-deeply ($csv.getline_all ($fh), [["a b", "3"],], "valid sep="); 125 | is (+$csv.error_diag, 2012, "EOF"); 126 | } 127 | 128 | { ok (my $csv = Text::CSV.new, "new for sep="); 129 | my $fh = Text::IO::String.new (qq{sep=;\n"a b",3\n}); 130 | is-deeply ($csv.getline_all ($fh), [], "invalid sep="); 131 | is (+$csv.error_diag, 2023, "error"); 132 | } 133 | 134 | { ok (my $csv = Text::CSV.new, "new for sep="); 135 | my $fh = Text::IO::String.new (qq{sep=XX\n"a b"XX3\n}); 136 | is-deeply ($csv.getline_all ($fh), [["a b", "3"],], "multibyte sep="); 137 | is (+$csv.error_diag, 2012, "EOF"); 138 | } 139 | 140 | { ok (my $csv = Text::CSV.new, "new for sep="); 141 | # To check that it is *only* supported on the first line 142 | my $fh = Text::IO::String.new (qq{sep=;\n"a b";3\nsep=,\n"a b",3\n}); 143 | is-deeply ($csv.getline_all ($fh), 144 | [["a b","3"],["sep=,"]], "sep= not on 1st line"); 145 | is (+$csv.error_diag, 2023, "error"); 146 | } 147 | 148 | done-testing; 149 | -------------------------------------------------------------------------------- /t/46_eol_si.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | use Text::IO::String; 9 | 10 | my Str $efn; 11 | my Str @rs = "\n", "\r\n", "\r"; 12 | my Str @eol = "\r", "\n", "\r\n", "\n\r", ""; 13 | 14 | for (|@rs) -> $rs { 15 | for (Str, $rs) -> $ors { 16 | 17 | my $csv = Text::CSV.new (); 18 | $ors.defined or $csv.eol ($rs); 19 | 20 | for (|@eol) -> $eol { 21 | $efn = ""; 22 | for (0, 1) -> $pass { 23 | my IO::Handle $fh; 24 | 25 | $fh = Text::IO::String.new ($efn, nl-in => $rs); 26 | $fh.nl-out = $ors.defined ?? $ors !! ""; 27 | 28 | my $s_eol = join " - ", $rs.perl, $ors.perl, $eol.perl; 29 | 30 | my @p; 31 | my @f = ("", "1", 32 | $eol, " $eol", "$eol ", " $eol ", "'$eol'", 33 | "\"$eol\"", " \" $eol \"\n ", "EOL"); 34 | 35 | if ($pass == 0) { 36 | ok ($csv.combine (@f), "combine |$s_eol|"); 37 | ok (my Str $str = $csv.string, "string |$s_eol|"); 38 | my $state = $csv.parse ($str); 39 | ok ($state, "parse |$s_eol|"); 40 | if ($state) { 41 | @p = $csv.strings; 42 | ok (@p.elems, "fields |$s_eol|"); 43 | } 44 | else{ 45 | is ($csv.error_input, $str, "error |$s_eol|"); 46 | } 47 | 48 | $fh.print ($str); 49 | } 50 | else { 51 | my @row = $csv.getline ($fh); 52 | ok (@row.elems, "getline |$s_eol|"); 53 | @p = @row; 54 | } 55 | 56 | is (@p.perl, @f.perl, "result |$s_eol|"); 57 | 58 | $fh.close; 59 | } 60 | } 61 | } 62 | } 63 | 64 | ok (True, "Auto-detecting \\r"); 65 | { my @row = < a b c >; 66 | my $row = @row.join (","); 67 | for ("\n", "\r\n", "\r") -> $eol { 68 | my $s_eol = $eol.perl; 69 | $efn = qq{$row$eol$row$eol$row$eol\x91}; 70 | my $fh = Text::IO::String.new ($efn, nl-in => Str, nl-out => Str); 71 | my $c = Text::CSV.new (:auto_diag); 72 | is ( $c.eol (), Str, "default EOL"); 73 | is ([$c.getline ($fh, :!meta)], [ @row, ], "EOL 1 $s_eol"); 74 | is ([$c.getline ($fh, :!meta)], [ @row, ], "EOL 2 $s_eol"); 75 | is ([$c.getline ($fh, :!meta)], [ @row, ], "EOL 3 $s_eol"); 76 | $fh.close; 77 | $efn = ""; 78 | } 79 | } 80 | 81 | ok (True, "EOL undefined"); 82 | { ok (my $csv = Text::CSV.new (eol => Str), "new csv with eol => Str"); 83 | my $fh = Text::IO::String.new ($efn); 84 | ok ($csv.print ($fh, [1, 2, 3]), "print 1"); 85 | ok ($csv.print ($fh, [4, 5, 6]), "print 2"); 86 | $fh.close; 87 | 88 | $fh = Text::IO::String.new ($efn); 89 | ok ((my @row = $csv.getline ($fh, :!meta)), "getline"); 90 | is (@row.elems, 5, "# fields"); 91 | is ([|@row], [ 1, 2, 34, 5, 6 ], "fields 1+2"); 92 | $fh.close; 93 | $efn = ""; 94 | } 95 | 96 | for ("!", "!!", "!\n", "!\n!", "!!!!!!!!", "!!!!!!!!!!", 97 | "\n!!!!!\n!!!!!", "!!!!!\n!!!!!\n", "%^+_\n\0!X**", 98 | "\r\n", "\r") -> $eol { 99 | my $s_eol = $eol.perl; 100 | ok (True, "EOL $s_eol"); 101 | ok ((my $csv = Text::CSV.new (:$eol)), "new csv with eol => $s_eol"); 102 | $efn = ""; 103 | my $fh = Text::IO::String.new ($efn, nl-out => Str); 104 | ok ($csv.print ($fh, [1, 2, 3]), "print 1"); 105 | ok ($csv.print ($fh, [4, 5, 6]), "print 2"); 106 | $fh.close; 107 | 108 | $csv.auto-diag (True); 109 | for (Str, "", "\n", $eol, "!", "!\n", "\n!", "!\n!", "\n!\n") -> $rs { 110 | my $s_rs = $rs.perl; 111 | ok (True, "with RS $s_rs / EOL $s_eol"); 112 | my $fh = Text::IO::String.new ($efn, :ro, nl-in => $rs); 113 | my @row = $csv.getline ($fh, :!meta); 114 | if (@row.elems == 3 && @row[2] eq "3") { 115 | is (@row.elems, 3, "field count"); 116 | is ([|@row], [ 1, 2, 3 ], "fields 1"); 117 | ok (( @row = $csv.getline ($fh, :!meta)), "getline 2"); 118 | is (@row.elems, 3, "field count"); 119 | is ([|@row], [ 4, 5, 6 ], "fields 2"); 120 | } 121 | else { #TODO? Or is this just too weird to try to support 122 | note "TODO: EOL = $s_eol, RS = $s_rs"; 123 | note " ", $efn.perl; 124 | note " --> ", @row.perl; 125 | #$csv.diag; 126 | } 127 | $fh.close; 128 | } 129 | $efn = ""; 130 | } 131 | 132 | done-testing; 133 | -------------------------------------------------------------------------------- /t/66_formula.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new (); 10 | 11 | is ($csv.formula, "none", "default"); 12 | is ($csv.formula ("die"), "die", "die"); 13 | is ($csv.formula ("croak"), "croak", "croak"); 14 | is ($csv.formula ("diag"), "diag", "diag"); 15 | is ($csv.formula ("empty"), "empty", "empty"); 16 | is ($csv.formula (""), "empty", "explicit empty"); 17 | is ($csv.formula ("undef"), "undef", "undef"); 18 | is ($csv.formula (Str), "undef", "explicit undef"); 19 | is ($csv.formula ("none"), "none", "none"); 20 | 21 | is ($csv.formula_handling, "none", "default"); 22 | is ($csv.formula_handling ("DIE"), "die", "DIE"); 23 | is ($csv.formula_handling ("CROAK"), "croak", "CROAK"); 24 | is ($csv.formula_handling ("DIAG"), "diag", "DIAG"); 25 | is ($csv.formula_handling ("EMPTY"), "empty", "EMPTY"); 26 | is ($csv.formula_handling ("UNDEF"), "undef", "UNDEF"); 27 | is ($csv.formula_handling ("NONE"), "none", "NONE"); 28 | 29 | is ($csv.formula-handling, "none", "default"); 30 | is ($csv.formula-handling ("die"), "die", "die"); 31 | is ($csv.formula-handling ("croak"), "croak", "croak"); 32 | is ($csv.formula-handling ("diag"), "diag", "diag"); 33 | is ($csv.formula-handling ("empty"), "empty", "empty"); 34 | is ($csv.formula-handling ("undef"), "undef", "undef"); 35 | is ($csv.formula-handling ("none"), "none", "none"); 36 | 37 | for ("xxx", "DIAX") -> $f { 38 | my $e; 39 | { is ($csv.formula ($f), "diag", "invalid"); 40 | CATCH { default { $e = $_; }} 41 | } 42 | is (+$e, 1500, "unsupported attribute '$f'"); 43 | } 44 | 45 | for < none die croak diag empty undef > -> $f { 46 | ok (my $p = Text::CSV.new (formula => $f), "new with $f"); 47 | is ($p.formula, $f, "Set to $f"); 48 | } 49 | 50 | for < none die croak diag empty undef > -> $formula { 51 | ok (my $p = Text::CSV.new (:$formula), "new with named $formula"); 52 | is ($p.formula, $formula, "Set to $formula"); 53 | } 54 | 55 | # Parser 56 | 57 | my @data = 58 | "a,b,c", 59 | "1,2,3", 60 | "=1+2,3,4", 61 | "1,=2+3,4", 62 | "1,2,=3+4"; 63 | 64 | sub parse (Str $formula) { 65 | ok (my $csv = Text::CSV.new (:$formula), "new $formula"); 66 | @data.map: { $csv.parse ($_); $csv.strings }; 67 | } # parse 68 | 69 | is-deeply (parse ("none"), ( 70 | [ "a", "b", "c", ], 71 | [ "1", "2", "3", ], 72 | [ "=1+2", "3", "4", ], 73 | [ "1", "=2+3", "4", ], 74 | [ "1", "2", "=3+4", ], 75 | ), "Default (none)"); 76 | 77 | my $e; 78 | { parse ("die"); 79 | CATCH { default { $e = $_ }} 80 | } 81 | is ($e, "Formulas are forbidden", "Parse formula with die"); 82 | { parse ("croak"); 83 | CATCH { default { $e = $_ }} 84 | } 85 | is ($e, "Formulas are forbidden", "Parse formula with croak"); 86 | 87 | my @e; 88 | { is-deeply (parse ("diag"), ( 89 | [ "a", "b", "c", ], 90 | [ "1", "2", "3", ], 91 | [ "=1+2", "3", "4", ], 92 | [ "1", "=2+3", "4", ], 93 | [ "1", "2", "=3+4", ], 94 | ), "Default"); 95 | CONTROL { when CX::Warn { @e.push: $_.Str; .resume } }; 96 | } 97 | is-deeply (@e, [ # These will change 98 | "Field 1 in record 3 contains formula '=1+2'\n", 99 | "Field 2 in record 4 contains formula '=2+3'\n", 100 | "Field 3 in record 5 contains formula '=3+4'\n", 101 | ], "Got expected warnings"); 102 | 103 | is-deeply (parse ("empty"), ( 104 | [ "a", "b", "c", ], 105 | [ "1", "2", "3", ], 106 | [ "", "3", "4", ], 107 | [ "1", "", "4", ], 108 | [ "1", "2", "", ], 109 | ), "Empty"); 110 | 111 | is-deeply (parse ("undef"), ( 112 | [ "a", "b", "c", ], 113 | [ "1", "2", "3", ], 114 | [ Str, "3", "4", ], 115 | [ "1", Str, "4", ], 116 | [ "1", "2", Str, ], 117 | ), "Undef"); 118 | 119 | sub writer (Str $formula) { 120 | ok (my $csv = Text::CSV.new (:$formula, :quote_empty), "new $formula"); 121 | ok ($csv.combine ("1", "=2+3", "4"), "combine $formula"); 122 | $csv.string; 123 | } # writer 124 | 125 | is ( writer ("none"), <1,=2+3,4>, "Out none"); 126 | is ( writer ("empty"), <1,"",4>, "Out empty"); 127 | is ( writer ("undef"), <1,,4>, "Out undef"); 128 | 129 | { writer ("die"); 130 | CATCH { default { $e = $_ }} 131 | } 132 | is ($e, "Formulas are forbidden", "Combine formula with die"); 133 | { writer ("croak"); 134 | CATCH { default { $e = $_ }} 135 | } 136 | is ($e, "Formulas are forbidden", "Combine formula with croak"); 137 | 138 | { @e = (); 139 | is ( writer ("diag"), <1,=2+3,4>, "Out diag"); 140 | CONTROL { when CX::Warn { @e.push: $_.Str; .resume } }; 141 | } 142 | is-deeply (@e, ["Field 2 contains formula '=2+3'\n"], "Got a warning"); 143 | 144 | { @e = (); 145 | ok (my $csv = Text::CSV.new (formula => "diag"), "new diag hr"); 146 | ok ($csv.column_names ("code", "value", "desc"), "Set column names"); 147 | ok ($csv.parse ("1,=2+3,4"), "Parse"); 148 | CONTROL { when CX::Warn { @e.push: $_.Str; .resume } }; 149 | } 150 | is-deeply (@e, 151 | ["Field 2 (column: 'value') in record 1 contains formula '=2+3'\n"], 152 | "Warning for HR"); 153 | 154 | done-testing; 155 | -------------------------------------------------------------------------------- /t/10_base.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new; 10 | 11 | ok ($csv, "New parser"); 12 | is ($csv.fields.elems, 0, "fields () before parse ()"); 13 | is ($csv.strings.elems, 0, "strings () before parse ()"); 14 | is ($csv.string, Str, "string () undef before combine"); 15 | is ($csv.status, True, "No failures yet"); 16 | 17 | ok (1, "combine () & string () tests"); 18 | is ($csv.combine (), True, "Combine no args"); 19 | is ($csv.string, Str, "String of no fields"); 20 | 21 | ok ($csv.combine (""), "Empty string - combine ()"); 22 | is ($csv.string, "", "Empty string - string ()"); 23 | ok ($csv.combine ("", " "), "Two fields, one space - combine ()"); 24 | is ($csv.string, '," "', "Two fields, one space - string ()"); 25 | ok ($csv.combine ("", 'I said, "Hi!"', ""), "Hi! - combine ()"); 26 | is ($csv.string, ',"I said, ""Hi!""",', "Hi! - string ()"); 27 | ok ($csv.combine ('"', "abc"), "abc - combine ()"); 28 | is ($csv.string, '"""",abc', "abc - string ()"); 29 | ok ($csv.combine (","), "comma - combine ()"); 30 | is ($csv.string, '","', "comma - string ()"); 31 | ok ($csv.combine ("abc", '"'), "abc + \" - combine ()"); 32 | is ($csv.string, 'abc,""""', "abc + \" - string ()"); 33 | ok ($csv.combine ("abc", "def", "ghi", "j,k"), "abc .. j,k - combine ()"); 34 | is ($csv.string, 'abc,def,ghi,"j,k"', "abc .. j,k - string ()"); 35 | ok ($csv.combine ("abc\tdef", "ghi"), "abc + TAB - combine ()"); 36 | is ($csv.string, qq{"abc\tdef",ghi}, "abc + TAB - string ()"); 37 | is ($csv.status, True, "No failures"); 38 | 39 | $csv.binary (False); 40 | is ($csv.error_input.defined, False, "No error saved yet"); 41 | is ($csv.combine ("abc", "def\n", "g"), False, "Bad character"); 42 | is ($csv.error_input, "def\n", "Error_input ()"); 43 | is ($csv.status, False, "Failure"); 44 | $csv.binary (True); 45 | 46 | ok (1, "parse () tests"); 47 | ok ($csv.parse ("\n"), "Single newline"); 48 | ok ($csv.parse ('","'), "comma - parse ()"); 49 | is ($csv.fields.elems, 1, "comma - fields () - count"); 50 | is ($csv.fields[0].text, ",", "comma - fields () - content"); 51 | is-deeply ([$csv.strings], [","], "As strings"); 52 | 53 | ok ($csv.parse (qq{"","I said,\t""Hi!""",""}), "Hi! - parse ()"); 54 | is ($csv.fields.elems, 3, "Hi! - fields () - count"); 55 | 56 | is ($csv.fields[0].text, "", "Hi! - fields () - field 1"); 57 | is ($csv.fields[1].text, qq{I said,\t"Hi!"}, "Hi! - fields () - field 2"); 58 | is ($csv.fields[2].text, "", "Hi! - fields () - field 3"); 59 | is ($csv.status, True, "status"); 60 | is-deeply ([$csv.strings], [ "", qq{I said,\t"Hi!"}, "" ], "As strings"); 61 | 62 | ok ($csv.parse (""), "Empty line"); 63 | is ($csv.fields.elems, 1, "Empty - count"); 64 | is ($csv.fields[0].text, "", "One empty field"); 65 | is-deeply ([$csv.strings], [""], "Return as data"); 66 | 67 | ok (1, "Integers and Reals"); 68 | ok ($csv.combine ("", 2, 3.25, "a", "a b"), "Mixed - combine ()"); 69 | is ($csv.string, ',2,3.25,a,"a b"', "Mixed - string ()"); 70 | 71 | # Basic error test 72 | ok (!$csv.parse ('"abc'), "Missing closing \""); 73 | # Test all error_diag contexts 74 | is (0 + $csv.error_diag, 2027, "diag numeric"); 75 | is ("" ~ $csv.error_diag, "EIQ - Quoted field not terminated", "diag string"); 76 | my @ed = $csv.error_diag; 77 | is (@ed[2], 4, "diag pos"); 78 | is (@ed[3], 1, "diag field"); 79 | is (@ed[4], 5, "diag record"); 80 | is (@ed[5], '"abc', "diag buffer"); 81 | is ($csv.error_diag[0], 2027, "diag error positional"); 82 | is ($csv.error_diag[4], 5, "diag record positional"); 83 | is ($csv.error_diag.error, 2027, "diag OO error"); 84 | is ($csv.error_diag.record, 5, "diag OO record"); 85 | ok (True, "The next two lines should show an error"); 86 | $csv.error_diag; # Call in void context 87 | # More fail tests 88 | ok (!$csv.parse ('ab"c'), "\" outside of \"'s"); 89 | ok (!$csv.parse ('"ab"c"'), "Bad character sequence"); 90 | is ($csv.status, False, "FAIL"); 91 | ok ($csv.parse (""), "Empty line"); 92 | is ($csv.status, True, "PASS again"); 93 | 94 | $csv.binary (False); 95 | ok (!$csv.parse (qq{"abc\nc"}), "Bad character (NL)"); 96 | is ($csv.status, False, "FAIL"); 97 | 98 | my $csv2 = $csv.new; 99 | ok ($csv2, "New from obj"); 100 | is ($csv2.^name, "Text::CSV", "Same object type"); 101 | 102 | # Test context 103 | 104 | done-testing; 105 | -------------------------------------------------------------------------------- /t/78_fragment.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | my $tfn = "_78matrix.csv"; END { unlink $tfn; } 7 | 8 | use Test; 9 | use Text::CSV; 10 | 11 | my $csv = Text::CSV.new; 12 | 13 | # Colranges on a single row 14 | my Str $str = (1 .. 10).join (","); 15 | my Str @exp = (1 .. 10).map (~*); 16 | is ([$csv.getline ($str).map (~*)], @exp, "no fragments"); 17 | $csv.colrange ([1,]); 18 | is ([$csv.getline ($str).map (~*)], @exp[1], "fragment [1]"); 19 | $csv.colrange ([1, 4]); 20 | is ([$csv.getline ($str).map (~*)], @exp[1,4], "fragment [1,4]"); 21 | $csv.colrange ([1, 4..6]); 22 | is ([$csv.getline ($str).map (~*)], @exp[1,4..6], "fragment [1,4..6]"); 23 | $csv.colrange ([1, 4..6, 8..Inf]); 24 | is ([$csv.getline ($str).map (~*)], @exp[1,4..6,8..Inf], "fragment [1,4..6,8..Inf]"); 25 | 26 | $csv.colrange ("2"); 27 | is ([$csv.getline ($str).map (~*)], @exp[1], "fragment '2'"); 28 | $csv.colrange ("2;5"); 29 | is ([$csv.getline ($str).map (~*)], @exp[1,4], "fragment '2;5'"); 30 | $csv.colrange ("2;5-7"); 31 | is ([$csv.getline ($str).map (~*)], @exp[1,4..6], "fragment '2;5-7'"); 32 | $csv.colrange ("2;5-7;9-*"); 33 | is ([$csv.getline ($str).map (~*)], @exp[1,4..6,8..Inf], "fragment '2;5-7;9-*'"); 34 | $csv.colrange ("2;5-7;5-6;2-2;7-7;9-*;12-*"); 35 | is ([$csv.getline ($str).map (~*)], @exp[1,4..6,8..Inf], "fragment '2;5-7;9-*' with overlaps"); 36 | $csv.colrange ("12-24;14-*"); 37 | is ([$csv.getline ($str).map (~*)], [[],], "out of bound fragment"); 38 | 39 | # Tests on a matrix 40 | my @expect = 41 | [11,12,13,14,15,16,17,18,19], 42 | [21,22,23,24,25,26,27,28,29], 43 | [31,32,33,34,35,36,37,38,39], 44 | [41,42,43,44,45,46,47,48,49], 45 | [51,52,53,54,55,56,57,58,59], 46 | [61,62,63,64,65,66,67,68,69], 47 | [71,72,73,74,75,76,77,78,79], 48 | [81,82,83,84,85,86,87,88,89], 49 | [91,92,93,94,95,96,97,98,99]; 50 | 51 | my $fh = open $tfn, :w; 52 | $fh.say ($_.join (",")) for @expect; 53 | $fh.close; 54 | 55 | sub to-int (@str) { [ @str.map ({$[ $_.map (*.Int) ]}) ]; } 56 | 57 | $csv = Text::CSV.new; 58 | 59 | $fh = open $tfn, :r; 60 | my @matrix = $csv.getline_all ($fh, :!meta); 61 | is-deeply (to-int (@matrix), @expect, "Whole matrix"); 62 | $fh.close; 63 | 64 | my @test = 65 | "row=1" => [[ 11,12,13,14,15,16,17,18,19 ],], 66 | "row=2-3" => [[ 21,22,23,24,25,26,27,28,29 ], 67 | [ 31,32,33,34,35,36,37,38,39 ]], 68 | "row=2;4;6" => [[ 21,22,23,24,25,26,27,28,29 ], 69 | [ 41,42,43,44,45,46,47,48,49 ], 70 | [ 61,62,63,64,65,66,67,68,69 ]], 71 | "row=1-2;4;6-*" => [[ 11,12,13,14,15,16,17,18,19 ], 72 | [ 21,22,23,24,25,26,27,28,29 ], 73 | [ 41,42,43,44,45,46,47,48,49 ], 74 | [ 61,62,63,64,65,66,67,68,69 ], 75 | [ 71,72,73,74,75,76,77,78,79 ], 76 | [ 81,82,83,84,85,86,87,88,89 ], 77 | [ 91,92,93,94,95,96,97,98,99 ]], 78 | "row=24" => $[], 79 | 80 | "col=1" => [[11],[21],[31],[41],[51],[61],[71],[81],[91]], 81 | "col=2-3" => [[12,13],[22,23],[32,33],[42,43],[52,53], 82 | [62,63],[72,73],[82,83],[92,93]], 83 | "col=2;4;6" => [[12,14,16],[22,24,26],[32,34,36],[42,44,46],[52,54,56], 84 | [62,64,66],[72,74,76],[82,84,86],[92,94,96]], 85 | "col=1-2;4;6-*" => [[11,12,14,16,17,18,19], [21,22,24,26,27,28,29], 86 | [31,32,34,36,37,38,39], [41,42,44,46,47,48,49], 87 | [51,52,54,56,57,58,59], [61,62,64,66,67,68,69], 88 | [71,72,74,76,77,78,79], [81,82,84,86,87,88,89], 89 | [91,92,94,96,97,98,99]], 90 | "col=24" => [[],[],[],[],[],[],[],[],[]], 91 | 92 | #cell=R,C 93 | "cell=7,7" => [[ 77 ],], 94 | "cell=7,7-8,8" => [[ 77,78 ], [ 87,88 ]], 95 | "cell=7,7-*,8" => [[ 77,78 ], [ 87,88 ], [ 97,98 ]], 96 | "cell=7,7-8,*" => [[ 77,78,79 ], [ 87,88,89 ]], 97 | "cell=7,7-*,*" => [[ 77,78,79 ], [ 87,88,89 ], [ 97,98,99 ]], 98 | 99 | "cell=1,1-2,2;3,3-4,4" => [ 100 | [11,12], 101 | [21,22], 102 | [33,34], 103 | [43,44]], 104 | "cell=1,1-3,3;2,3-4,4" => [ 105 | [11,12,13], 106 | [21,22,23,24], 107 | [31,32,33,34], 108 | [43,44]], 109 | "cell=1,1-3,3;2,2-4,4;2,3;4,2" => [ 110 | [11,12,13], 111 | [21,22,23,24], 112 | [31,32,33,34], 113 | [42,43,44]], 114 | "cell=1,1-2,2;3,3-4,4;1,4;4,1" => [ 115 | [11,12, 14], 116 | [21,22], 117 | [33,34], 118 | [41, 43,44]], 119 | ; 120 | 121 | for @test -> $t { 122 | my $spec = $t.key; 123 | my $expt = $t.value; 124 | 125 | $fh = open $tfn, :r; 126 | is-deeply (to-int ($csv.fragment ($fh, $spec, :!meta)), $expt, "spec: $spec"); 127 | $fh.close; 128 | } 129 | 130 | $csv.column_names ("c1"); 131 | $fh = open $tfn, :r; 132 | is-deeply ($csv.fragment ($fh, "row=3"), 133 | [{ :c1("31") },], "Fragment to AoH (row)"); 134 | $fh.close; 135 | 136 | $csv.column_names (< x x c3 >); 137 | $fh = open $tfn, :r; 138 | my @rx; 139 | # { c3 => 3 } is a hash 140 | # { c3 => ~(10 * $_ + 3) } is a closure generating a pair 141 | # @rx = (1..9).map ({ :c3(~(10 * $_ + 3)).hash.item }); 142 | for (flat 1..9) -> $x { @rx.push: ${ c3 => ~(10 * $x + 3) }}; 143 | is-deeply ($csv.fragment ($fh, "col=3"), 144 | [ @rx ], "Fragment to AoH (col)"); 145 | $fh.close; 146 | 147 | $csv.column_names ("c3","c4"); 148 | $fh = open $tfn, :r; 149 | is-deeply ($csv.fragment ($fh, "cell=3,2-4,3"), 150 | [{ :c3("32"), :c4("33") }, 151 | { :c3("42"), :c4("43") }], "Fragment to AoH (cell)"); 152 | $fh.close; 153 | 154 | done-testing; 155 | -------------------------------------------------------------------------------- /t/20_file.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new (:!binary, eol => "\n", :meta); 10 | 11 | my $tf20 = "_20test.csv"; 12 | 13 | my $fh = open $tf20, :w or die "$tf20: $!"; 14 | ok (!$csv.print ($fh, "abc", "def\007", "ghi"), "print bad character"); 15 | $fh.close; 16 | 17 | # All these tests are without EOL, thus testing EOF 18 | sub io_test (int $tst, Bool $print-valid, int $error, *@arg) { 19 | 20 | $fh = open $tf20, :w or die "$tf20: $!"; 21 | is ($csv.print ($fh, @arg), $print-valid, "$tst - print ()"); 22 | $fh.close; 23 | 24 | $fh = open $tf20, :w or die "$tf20: $!"; 25 | $fh.print (join ",", @arg); 26 | $fh.close; 27 | 28 | $fh = open $tf20, :r or die "$tf20: $!"; 29 | my @row = $csv.getline ($fh); 30 | is ($csv.status, !?$error, "$tst - getline status"); 31 | is ($csv.error_diag.error, $error, "$tst - getline error code"); 32 | $error and return; 33 | ok (@row.elems, "$tst - good getline ()"); 34 | $tst == 12 and @arg = (",", "", ""); 35 | loop (my $a = 0; $a < @arg.elems; $a++) { 36 | my $exp = @arg[$a]; 37 | $exp ~~ s{^ '"' (.*) '"' $} = $0; 38 | is (@row[$a].text, $exp, "$tst - field $a"); 39 | } 40 | ok ($csv.parse (""), "$tst - reset parser"); 41 | } 42 | io_test ( 1, True, 0, '""' ); 43 | io_test ( 2, True, 0, '', '' ); 44 | io_test ( 3, True, 2034, '', 'I said, "Hi!"', ''); 45 | io_test ( 4, True, 2027, '"', 'abc' ); 46 | io_test ( 5, True, 2027, 'abc', '"' ); 47 | io_test ( 6, True, 0, 'abc', 'def', 'ghi' ); 48 | io_test ( 7, True, 0, "abc\tdef", 'ghi' ); 49 | io_test ( 8, True, 2027, '"abc' ); 50 | io_test ( 9, True, 2034, 'ab"c' ); 51 | io_test (10, True, 2023, '"ab"c"' ); 52 | io_test (11, False, 2021, qq{"abc\nc"} ); 53 | io_test (12, True, 0, qq{","}, ',' ); 54 | io_test (13, True, 2034, qq{"","I said,\t""Hi!""",""}, '', qq{I said,\t"Hi!"}, '' ); 55 | 56 | unlink $tf20; 57 | 58 | # This test because of a problem with DBD::CSV 59 | 60 | ok (1, "Tests for DBD::CSV"); 61 | $fh = open $tf20, :w or die "$tf20: $!"; 62 | $csv.binary (True); 63 | $csv.eol ("\r\n"); 64 | ok ($csv.print ($fh, "id", "name" ), "Bad character"); 65 | ok ($csv.print ($fh, 1, "Alligator Descartes" ), "Name 1"); 66 | ok ($csv.print ($fh, "3", "Jochen Wiedmann" ), "Name 2"); 67 | ok ($csv.print ($fh, 2, "Tim Bunce" ), "Name 3"); 68 | ok ($csv.print ($fh, " 4", "Andreas König" ), "Name 4"); 69 | ok ($csv.print ($fh, 5 ), "Name 5"); 70 | $fh.close; 71 | 72 | my $expected = qq :to "CONTENTS"; 73 | id,name\r 74 | 1,"Alligator Descartes"\r 75 | 3,"Jochen Wiedmann"\r 76 | 2,"Tim Bunce"\r 77 | " 4","Andreas König"\r 78 | 5\r 79 | CONTENTS 80 | 81 | is ((slurp $tf20, :bin).decode, $expected, "Content"); 82 | 83 | $csv.eol (Str); # \r\n is translated to \n by raku 84 | $fh = open $tf20, :r or die "$tf20: $!"; 85 | my @fields; 86 | ok (True, "# Retrieving data"); 87 | for ^6 -> $tst { 88 | ok ((@fields = $csv.getline ($fh)), "Fetch record $tst"); 89 | is ($csv.eof, False, "EOF"); 90 | } 91 | ok (!$csv.getline ($fh), "Fetch record 6"); 92 | is ($csv.eof, True, "EOF"); 93 | 94 | # Edge cases 95 | $csv = Text::CSV.new (escape => "+", :!binary, eol => "\n"); 96 | sub esc_test (int $tst, int $err is copy, Str $str) { 97 | $fh = open $tf20, :w or die "$tf20: $!"; 98 | $fh.print ($str); 99 | $fh.close; 100 | $fh = open $tf20, :r or die "$tf20: $!"; 101 | my @row = $csv.getline ($fh); 102 | $fh.close; 103 | is (+$csv.error_diag, $err, "$tst - expected error $err (IO)"); 104 | 105 | $err == 2012 and $err = 2027; 106 | @row = $csv.getline ($str); 107 | is (+$csv.error_diag, $err, "$tst - expected error $err (Str)"); 108 | } 109 | 110 | esc_test ( 1, 0, "\n"); 111 | esc_test ( 2, 2025, "+\n"); 112 | esc_test ( 3, 2035, "+"); 113 | esc_test ( 4, 2021, qq{"+"\n}); 114 | esc_test ( 5, 2025, qq{"+\n}); 115 | esc_test ( 6, 2011, qq{""+\n}); 116 | esc_test ( 7, 2027, qq{"+"}); 117 | esc_test ( 8, 2024, qq{"+}); 118 | esc_test ( 9, 2011, qq{""+}); 119 | esc_test (10, 2031, "\r"); 120 | esc_test (11, 2031, "\r\r"); 121 | esc_test (12, 2032, " \r"); 122 | esc_test (13, 2025, "+\r\r"); 123 | esc_test (14, 2025, "+\r\r+"); 124 | esc_test (15, 2022, qq{"\r"}); 125 | esc_test (16, 2022, qq{"\r\r" }); 126 | esc_test (17, 2022, qq{"\r\r"\t}); 127 | esc_test (18, 2025, qq{"+\r\r"}); 128 | esc_test (19, 2025, qq{"+\r\r+"}); 129 | esc_test (20, 2022, qq{"\r"\r}); 130 | esc_test (21, 2022, qq{"\r\r"\r}); 131 | esc_test (22, 2025, qq{"+\r\r"\r}); 132 | esc_test (23, 2025, qq{"+\r\r+"\r}); 133 | 134 | $csv.binary (True); 135 | esc_test (31, 0, "\n"); 136 | esc_test (32, 2025, "+\n"); 137 | esc_test (33, 2035, "+"); 138 | esc_test (34, 2012, qq{"+"\n}); 139 | esc_test (35, 2025, qq{"+\n}); 140 | esc_test (36, 2011, qq{""+\n}); 141 | esc_test (37, 2027, qq{"+"}); 142 | esc_test (38, 2024, qq{"+}); 143 | esc_test (39, 2011, qq{""+}); 144 | esc_test (40, 0, "\r"); 145 | esc_test (41, 0, "\r\r"); 146 | esc_test (41, 0, " \r"); 147 | esc_test (42, 2025, "+\r\r"); 148 | esc_test (43, 2025, "+\r\r+"); 149 | esc_test (44, 0, qq{"\r"}); 150 | esc_test (45, 2011, qq{"\r\r" }); 151 | esc_test (46, 2011, qq{"\r\r"\t}); 152 | esc_test (47, 2025, qq{"+\r\r"}); 153 | esc_test (48, 2025, qq{"+\r\r+"}); 154 | esc_test (49, 2011, qq{"\r"\r}); 155 | esc_test (50, 2011, qq{"\r\r"\r}); 156 | esc_test (51, 2025, qq{"+\r\r"\r}); 157 | esc_test (52, 2025, qq{"+\r\r+"\r}); 158 | 159 | unlink $tf20; 160 | 161 | done-testing; 162 | -------------------------------------------------------------------------------- /README.speed: -------------------------------------------------------------------------------- 1 | In the reports I daily send/sent to the raku development channel on IRC, 2 | the lines I show like 3 | 4 | Rakudo version 2017.09-513-g2c4868b85 - MoarVM version 2017.09.1-622-g6e9e89ee 5 | csv-test-xs-20 0.441 - 0.450 6 | csv-ip5xs 1.155 - 1.166 7 | test-t 3.067 - 3.094 8 | test 11.436 - 11.599 9 | csv-parser 11.566 - 11.789 10 | csv-ip5xs-20 13.860 - 14.259 11 | test-t-20 --race 19.341 - 19.486 12 | test-t-20 56.192 - 57.096 13 | 14 | The first line obviously shows the version of Rakudo the raku tests were run 15 | under. Then there are several lines with the test combination tested followed 16 | by the runtime of that case in seconds (lower is better). Each line reports 17 | two timings: the fastest and the slowest of multiple runs (currently 2). 18 | 19 | See time.pl and time-twice.pl 20 | 21 | csv-test-xs: perl5 + Text::CSV_XS (perl5 XS) 22 | csv-ip5xs : raku + Inline::Perl5 + Text::CSV_XS (raku + perl5 XS) 23 | test : raku + an unoptimized early draft of Text::CSV (pure raku) 24 | test-t : raku + the full-featured current Text::CSV (pure raku) 25 | csv-parser : raku + Tony-O's CSV::Parser (pure raku) 26 | 27 | If a case has -20 in the name, it is the same test methos as without, but it 28 | runs the test on a CSV file that is 20 times bigger than the default test file. 29 | The default test file has 10000 lines of CSV with 5 fields each, the big one 30 | has 200000 lines. 31 | 32 | The graphs just show the history of test-t 33 | 34 | For the speedtests, see https://bitbucket.org/ewanhiggs/csv-game 35 | 36 | sh$ for i in $(seq 1 1000000); do echo 'hello,","," ",world,"!"'; done > /tmp/hello.csv 37 | sh$ time perl csv.pl < /tmp/hello.csv 38 | 39 | sh test.sh 40 | 41 | i686 i686 x68_64 x68_64 x68_64 x68_64 42 | 20141007 20141014 20141105 20141111 20141117 20150102 43 | ------------------ -------- -------- -------- -------- -------- -------- 44 | Text::CSV::Easy_XS 0.022 0.021 0.037 0.018 0.017 0.017 45 | Text::CSV::Easy_PP 0.018 0.022 0.028 0.016 0.016 0.016 46 | Text::CSV_XS 0.038 0.039 0.046 0.039 0.036 0.036 47 | Text::CSV_PP 0.651 0.535 0.533 0.516 0.510 0.510 48 | Pegex::CSV 1.947 1.420 1.387 1.371 1.348 1.356 49 | csv.pl 12.543 8.437 9.152 9.130 8.715 8.249 50 | csv_gram.pl - - - - - 19.501 51 | test.pl 256.985 201.621 71.847 72.221 65.279 59.042 52 | test-t.pl - - - 72.024 65.202 59.869 53 | 54 | 20150109 20150110 20150114 20150204 20150212 20150218 55 | ------------------ -------- -------- -------- -------- -------- -------- 56 | Text::CSV::Easy_XS 0.015 0.015 0.015 0.023 0.016 0.016 57 | Text::CSV::Easy_PP 0.016 0.016 0.017 0.021 0.016 0.016 58 | Text::CSV_XS 0.037 0.038 0.039 0.040 0.039 0.038 59 | Text::CSV_PP 0.520 0.532 0.518 0.518 0.514 0.519 60 | Pegex::CSV 1.360 1.367 1.348 1.382 1.356 1.416 61 | csv.pl 8.571 8.436 8.332 8.314 8.133 8.137 62 | csv-ip5xs - - - 9.223 8.950 9.230 63 | csv-ip5pp - - - - 9.812 9.778 64 | csv_gram.pl 14.107 13.965 14.023 13.860 13.426 13.544 65 | test.pl 40.916 41.197 39.751 39.805 38.733 39.084 66 | test-t.pl 41.407 40.535 38.384 42.080 39.502 38.119 67 | 68 | 20150222 20150223 20150305 20150309 20150331 20150422 69 | ------------------ -------- -------- -------- -------- -------- -------- 70 | Text::CSV::Easy_XS 0.018 0.016 0.017 0.016 0.016 0.016 71 | Text::CSV::Easy_PP 0.017 0.016 0.017 0.017 0.016 0.016 72 | Text::CSV_XS bindc 0.033 0.033 0.033 0.032 0.033 0.033 73 | Text::CSV_XS 0.040 0.037 0.039 0.038 0.038 0.040 74 | Text::CSV_PP 0.519 0.518 0.517 0.514 0.527 0.522 75 | Pegex::CSV 1.357 1.370 1.360 1.384 1.340 1.351 76 | csv.pl 8.442 6.663 7.161 6.917 6.669 7.102 77 | csv-ip5xs 9.425 9.076 13.256 13.128 15.870 17.087 78 | csv-ip5xsio - - - - 15.349 16.704 79 | csv-ip5pp 9.983 9.845 13.973 13.711 16.489 17.815 80 | csv_gram.pl 13.197 12.596 13.474 13.226 13.440 13.876 81 | test.pl 41.505 39.047 40.162 38.633 39.618 40.937 82 | test-t.pl 40.628 37.194 36.658 35.000 35.903 37.067 83 | csv-parser.pl - - - - 389.192 24.922 84 | 85 | 20150426 20150618 20150623 20150713 86 | ------------------ -------- -------- -------- -------- 87 | Text::CSV::Easy_XS 0.016 0.017 0.016 0.017 88 | Text::CSV::Easy_PP 0.017 0.016 0.016 0.017 89 | Text::CSV_XS bindc 0.034 0.033 0.033 0.033 90 | Text::CSV_XS 0.039 0.036 0.042 0.039 91 | Text::CSV_PP 0.525 0.505 0.508 0.512 92 | Pegex::CSV 1.340 1.311 1.279 1.317 93 | csv.pl 7.270 7.763 7.927 8.650 94 | csv-ip5xs 17.267 16.728 16.016 x 95 | csv-ip5xsio 17.243 16.742 16.061 x 96 | csv-ip5pp 18.218 17.496 16.411 x 97 | csv_gram.pl 14.226 14.541 14.538 16.157 98 | test.pl 44.541 43.057 42.986 46.251 99 | test-t.pl 39.887 41.265 43.348 46.427 100 | csv-parser.pl 25.712 25.919 23.854 30.226 101 | -------------------------------------------------------------------------------- /t/67_emptrow.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $csv = Text::CSV.new (); 10 | 11 | my $tfn = "_67test.csv"; END { unlink $tfn; } 12 | 13 | is ($csv.skip_empty_rows, 0, "default"); 14 | is ($csv.skip_empty_rows (False), 0, "False"); 15 | is ($csv.skip_empty_rows (0), 0, "+0"); 16 | is ($csv.skip_empty_rows ("0"), 0, "'0'"); 17 | is ($csv.skip_empty_rows (True), 1, "True"); 18 | is ($csv.skip_empty_rows (1), 1, "+1"); 19 | is ($csv.skip_empty_rows ("1"), 1, "'1'"); 20 | is ($csv.skip_empty_rows ("skip"), 1, "skip"); 21 | is ($csv.skip_empty_rows ("SKIP"), 1, "SKIP"); 22 | is ($csv.skip_empty_rows (2), 2, "+2"); 23 | is ($csv.skip_empty_rows ("2"), 2, "'2'"); 24 | is ($csv.skip_empty_rows ("eof"), 2, "eof"); 25 | is ($csv.skip_empty_rows ("EOF"), 2, "EOF"); 26 | is ($csv.skip_empty_rows ("stop"), 2, "stop"); 27 | is ($csv.skip_empty_rows ("STOP"), 2, "STOP"); 28 | is ($csv.skip_empty_rows (3), 3, "+3"); 29 | is ($csv.skip_empty_rows ("3"), 3, "'3'"); 30 | is ($csv.skip_empty_rows ("die"), 3, "die"); 31 | is ($csv.skip_empty_rows ("DIE"), 3, "DIE"); 32 | is ($csv.skip_empty_rows (4), 4, "+4"); 33 | is ($csv.skip_empty_rows ("4"), 4, "'4'"); 34 | is ($csv.skip_empty_rows ("croak"), 4, "croak"); 35 | is ($csv.skip_empty_rows ("CROAK"), 4, "CROAK"); 36 | is ($csv.skip_empty_rows (5), 5, "+5"); 37 | is ($csv.skip_empty_rows ("5"), 5, "'5'"); 38 | is ($csv.skip_empty_rows ("error"), 5, "error"); 39 | is ($csv.skip_empty_rows ("ERROR"), 5, "ERROR"); 40 | is ($csv.skip_empty_rows ({<1>}), 6, "<1>"); 41 | 42 | is ($csv.skip-empty-rows (True), 1, "True"); 43 | is ($csv.skip-empty-rows (1), 1, "+1"); 44 | is ($csv.skip-empty-rows ("1"), 1, "'1'"); 45 | is ($csv.skip-empty-rows ("skip"), 1, "skip"); 46 | is ($csv.skip-empty-rows ("SKIP"), 1, "SKIP"); 47 | is ($csv.skip-empty-rows (2), 2, "+2"); 48 | is ($csv.skip-empty-rows ("2"), 2, "'2'"); 49 | is ($csv.skip-empty-rows ("eof"), 2, "eof"); 50 | is ($csv.skip-empty-rows ("EOF"), 2, "EOF"); 51 | is ($csv.skip-empty-rows ("stop"), 2, "stop"); 52 | is ($csv.skip-empty-rows ("STOP"), 2, "STOP"); 53 | is ($csv.skip-empty-rows (3), 3, "+3"); 54 | is ($csv.skip-empty-rows ("3"), 3, "'3'"); 55 | is ($csv.skip-empty-rows ("die"), 3, "die"); 56 | is ($csv.skip-empty-rows ("DIE"), 3, "DIE"); 57 | is ($csv.skip-empty-rows (4), 4, "+4"); 58 | is ($csv.skip-empty-rows ("4"), 4, "'4'"); 59 | is ($csv.skip-empty-rows ("croak"), 4, "croak"); 60 | is ($csv.skip-empty-rows ("CROAK"), 4, "CROAK"); 61 | is ($csv.skip-empty-rows (5), 5, "+5"); 62 | is ($csv.skip-empty-rows ("5"), 5, "'5'"); 63 | is ($csv.skip-empty-rows ("error"), 5, "error"); 64 | is ($csv.skip-empty-rows ("ERROR"), 5, "ERROR"); 65 | is ($csv.skip-empty-rows ({<1>}), 6, "<1>"); 66 | 67 | is ($csv.skip-empty-rows (False), 0, "False"); 68 | is ($csv.skip-empty-rows (0), 0, "+0"); 69 | is ($csv.skip-empty-rows ("0"), 0, "'0'"); 70 | 71 | sub CB (Text::CSV $x) returns Str { return "3,42,,3" } 72 | 73 | is ($csv.skip-empty-rows (&CB), 6, "callback"); 74 | 75 | my $fh = open $tfn, :w; 76 | $fh.say: "a,b,c,d"; 77 | $fh.say: "1,2,0,4"; 78 | $fh.say: "4,0,9,1"; 79 | $fh.say: ""; 80 | $fh.say: "8,2,7,1"; 81 | $fh.say: ""; 82 | $fh.say: ""; 83 | $fh.say: "5,7,9,3"; 84 | $fh.say: ""; 85 | $fh.close; 86 | 87 | sub ser_csv (Bool $hsh, Any $ser) { 88 | return csv (auto-diag => 0, in => $tfn, skip-empty-rows => $ser, headers => $hsh); 89 | } # ser_csv 90 | 91 | sub check (Bool $hsh, Any $ser, Str $tst, *@exp) { 92 | my @got = ser_csv ($hsh, $ser); 93 | is-deeply (@got, @exp, $tst); 94 | } # check 95 | 96 | # Array behavior 97 | check (False, False, "A default", [ 98 | ["a","b","c","d"], ["1","2","0","4"], ["4","0","9","1"], 99 | [""], ["8","2","7","1"], [""], [""], ["5","7","9","3"], [""]]); 100 | 101 | check (False, True, "A skip", [ 102 | ["a","b","c","d"], ["1","2","0","4"], ["4","0","9","1"], 103 | ["8","2","7","1"], ["5","7","9","3"]]); 104 | 105 | check (False, "stop", "A stop", [ 106 | ["a","b","c","d"], ["1","2","0","4"], ["4","0","9","1"]]); 107 | 108 | check (False, "error", "A error", [ # Error 2015 109 | ["a","b","c","d"], ["1","2","0","4"], ["4","0","9","1"]]); 110 | 111 | { my $x; 112 | my $e; 113 | { $x = check (False, "die", "A die", []); 114 | CATCH { default { $e = $_ }} 115 | } 116 | is ($x, Any, "A It should have stopped"); 117 | is ($e.payload, "Empty row", "A Error message"); 118 | } 119 | 120 | check (False, { "1,2,3,4" }, "A cb", [ 121 | ["a","b","c","d"], ["1","2","0","4"], ["4","0","9","1"], 122 | ["1","2","3","4"], ["8","2","7","1"], ["1","2","3","4"], 123 | ["1","2","3","4"], ["5","7","9","3"], ["1","2","3","4"]]); 124 | 125 | # Hash behavior 126 | check (True, False, "H default", [ 127 | {:a("1"),:b("2"),:c("0"),:d("4")}, {:a("4"),:b("0"),:c("9"),:d("1")}, 128 | {:a("")}, {:a("8"),:b("2"),:c("7"),:d("1")}, 129 | {:a("")}, {:a("")}, 130 | {:a("5"),:b("7"),:c("9"),:d("3")}, 131 | {:a("")}]); 132 | 133 | check (True, True, "H skip", [ 134 | {:a("1"),:b("2"),:c("0"),:d("4")}, {:a("4"),:b("0"),:c("9"),:d("1")}, 135 | {:a("8"),:b("2"),:c("7"),:d("1")}, {:a("5"),:b("7"),:c("9"),:d("3")}]); 136 | 137 | check (True, "stop", "H stop", [ 138 | {:a("1"),:b("2"),:c("0"),:d("4")}, {:a("4"),:b("0"),:c("9"),:d("1")}]); 139 | 140 | check (True, "error", "H error", [ # Error 2015 141 | {:a("1"),:b("2"),:c("0"),:d("4")}, {:a("4"),:b("0"),:c("9"),:d("1")}]); 142 | 143 | { my $x; 144 | my $e; 145 | { $x = check (True, "die", "H die", []); 146 | CATCH { default { $e = $_ }} 147 | } 148 | is ($x, Any, "H It should have stopped"); 149 | is ($e.payload, "Empty row", "H Error message"); 150 | } 151 | 152 | check (True, { "1,2,3,4" }, "H cb", [ 153 | {:a("1"),:b("2"),:c("0"),:d("4")}, {:a("4"),:b("0"),:c("9"),:d("1")}, 154 | {:a("1"),:b("2"),:c("3"),:d("4")}, {:a("8"),:b("2"),:c("7"),:d("1")}, 155 | {:a("1"),:b("2"),:c("3"),:d("4")}, {:a("1"),:b("2"),:c("3"),:d("4")}, 156 | {:a("5"),:b("7"),:c("9"),:d("3")}, {:a("1"),:b("2"),:c("3"),:d("4")}]); 157 | 158 | done-testing; 159 | -------------------------------------------------------------------------------- /csv.pl: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | class Text::CSV { 4 | has Str $.quote_char is rw = '"'; 5 | has Str $.escape_char is rw = '"'; 6 | has Str $.sep_char is rw = ','; 7 | has Str $.eol is rw; # = ($*IN.newline), 8 | has Bool $.always_quote is rw; 9 | has Bool $.quote_space is rw = True; 10 | has Bool $.quote_null is rw = True; 11 | has Bool $.quote_binary is rw = True; 12 | has Bool $.binary is rw; 13 | has Bool $.keep_meta_info is rw; 14 | has Bool $.allow_loose_quotes is rw; 15 | has Bool $.allow_loose_escapes is rw; 16 | has Bool $.allow_whitespace is rw; 17 | has Bool $.blank_is_undef is rw; 18 | has Bool $.empty_is_undef is rw; 19 | has Bool $.verbatim is rw; 20 | has Bool $.auto_diag is rw; 21 | 22 | has @!fields; 23 | 24 | method parse(Str:D $line){ 25 | enum State ; 26 | 27 | my State $state = State::Start; 28 | my State $saved_state; 29 | my Str $field; 30 | my Int $index; 31 | my Str $input; 32 | 33 | my sub append(Str:D $char){ 34 | $field ~= $char; 35 | } 36 | 37 | my sub non_nil{ 38 | $field ~= ''; 39 | } 40 | 41 | my sub store(){ 42 | @!fields.push($field); 43 | $field = Nil; 44 | } 45 | 46 | my sub push_state(State $ns){ 47 | $saved_state = $state; 48 | $state = $ns; 49 | } 50 | 51 | my sub pop_state(){ 52 | $state = $saved_state; 53 | } 54 | 55 | my sub parse_error(Str:D $reason, *@args){ 56 | my $msg = $reason.sprintf(@args); 57 | die "$msg\n$line\n" ~ ' ' x $index ~ "^\n"; 58 | } 59 | 60 | @!fields = (); 61 | 62 | my Int $last=$line.chars; 63 | $index=0; 64 | while $index < $last { # 30% faster than 0..^$line.chars ... 65 | #for 0..^$line.chars -> Int:D $lindex { 66 | # $index = $lindex; 67 | $input = $line.substr($index,1); 68 | given $state { 69 | when State::Start { 70 | given $input { 71 | when $!sep_char { store; } 72 | when $!quote_char { non_nil; $state = State::QuotedData; } 73 | #when $!escape_char { $state = State::Data; push_state(State::Escape); } 74 | default { append($_); $state = State::Data; } 75 | } 76 | } 77 | when State::Data { 78 | given $input { 79 | when $!sep_char { store; $state = State::Start; } 80 | #when $!escape_char { push_state(State::Escape); } 81 | when $!quote_char { parse_error("Halfway quoting is forbidden"); } 82 | default { append($_); } 83 | } 84 | } 85 | when State::QuotedData { 86 | given $input { 87 | when $!quote_char { $state = State::Finish; } 88 | #when $!escape_char { push_state(State::Escape); } 89 | default { append($_); } 90 | } 91 | } 92 | when State::Escape { 93 | given $input { 94 | when $!sep_char|$!quote_char|$!escape_char { append($_); pop_state; } 95 | default { parse_error("Illegally escaped character"); } 96 | } 97 | } 98 | when State::Finish { 99 | given $input { 100 | when $!sep_char { store; $state = State::Start; } 101 | default { parse_error("Seperator ('%s') expected", $!sep_char); } 102 | } 103 | } 104 | default { say "What state?", $_ } 105 | } 106 | ++$index; 107 | } 108 | given $state { 109 | when State::Start|State::Finish|State::Data { store } 110 | default { parse_error("Inproper state to end the line (%s)", $state); } 111 | } 112 | } 113 | 114 | method getline(){ 115 | @!fields; 116 | } 117 | } 118 | 119 | sub MAIN( 120 | Str :$quote_char = '"', 121 | Str :$escape_char = '"', 122 | Str :$sep_char = ',', 123 | Str :$eol, # = ($*IN.newline), 124 | Bool :$always_quote, 125 | Bool :$quote_space = True, 126 | Bool :$quote_null = True, 127 | Bool :$quote_binary = True, 128 | Bool :$binary, 129 | Bool :$keep_meta_info, 130 | Bool :$allow_loose_quotes, 131 | Bool :$allow_loose_escapes, 132 | Bool :$allow_whitespace, 133 | Bool :$blank_is_undef, 134 | Bool :$empty_is_undef, 135 | Bool :$verbatim, 136 | Bool :$auto_diag, 137 | ) { 138 | 139 | my $csv_parser = Text::CSV.new 140 | :$quote_char 141 | :$escape_char 142 | :$sep_char 143 | :$eol 144 | :$always_quote 145 | :$quote_space 146 | :$quote_null 147 | :$quote_binary 148 | :$binary 149 | :$keep_meta_info 150 | :$allow_loose_quotes 151 | :$allow_loose_escapes 152 | :$allow_whitespace 153 | :$blank_is_undef 154 | :$empty_is_undef 155 | :$verbatim 156 | :$auto_diag 157 | ; 158 | #my Str $sep ='"'; 159 | #say $csv_parser.perl; 160 | $csv_parser.parse(q/ab,cde,"q",/); 161 | say $csv_parser.getline().perl; 162 | $csv_parser.sep_char='e'; 163 | $csv_parser.parse(q/ab,cde"q"e/); 164 | say $csv_parser.getline().perl; 165 | #$csv_parser.parse(q/ab,cde"q"eaa"aaarghh/); 166 | #$csv_parser.parse(q/ab,cde"q"e"aaarghh/); 167 | $csv_parser.sep_char=','; 168 | my $sum = 0; 169 | for lines() :eager { 170 | $csv_parser.parse($_); 171 | my @r = $csv_parser.getline(); 172 | #say @r.perl; 173 | $sum += +@r; 174 | } 175 | say $sum; 176 | } 177 | -------------------------------------------------------------------------------- /t/80_diag.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | use Text::IO::String; 9 | 10 | my %err; 11 | 12 | # Read errors from rakumod 13 | { my $pm = open "lib/Text/CSV.rakumod", :r; 14 | for $pm.lines () { 15 | m{^ \s* ";" $} and last; 16 | m{^ \s+ (<[0..9]>+) \s+ "=>" \s+ '"' (.*) '",' $} 17 | and %err{$0.Num} = $1.Str; 18 | } 19 | } 20 | 21 | my $csv = Text::CSV.new (); 22 | is (+$csv.error_diag, 0, "initial state is no error"); 23 | is (~$csv.error_diag, "", "initial state is no error"); 24 | is-deeply ([ $csv.error_diag ], [ 0, "", 0, 0, 0, ""], "OK in list context"); 25 | 26 | my $recno = 1; 27 | 28 | sub parse_err (Int $err, Int $pos, Int $fld, Str $buf) { 29 | my $s_err = %err{$err}; 30 | is ($csv.parse ($buf), False, "$err - Err for parse ({$buf.perl})"); 31 | is (+$csv.error_diag, $err, "$err - Diag in numerical context"); 32 | is (~$csv.error_diag, $s_err, "$err - Diag in string context"); 33 | my @diag = $csv.error_diag; 34 | is (@diag[0], $err, "$err - Num diag in list context"); 35 | is (@diag[1], $s_err, "$err - Str diag in list context"); 36 | is (@diag[2], $pos, "$err - Pos diag in list context"); 37 | is (@diag[3], $fld, "$err - Fld diag in list context"); 38 | is (@diag[4], $recno++, "$err - Rec diag in list context"); 39 | is (@diag[9], Any, "$err - no such diag"); 40 | } # parse_err 41 | 42 | parse_err (2023, 19, 2, qq{2023,",2008-04-05,"Foo, Bar",\n}); # " 43 | 44 | $csv = Text::CSV.new (escape => "+", eol => "\n", :!binary); 45 | is (~$csv.error_diag, "", "No errors yet"); 46 | 47 | $recno = 1; 48 | #parse_err (2010, 3, 1, qq{"x"\r}); # perl5 only 49 | parse_err (2011, 3, 1, qq{"x"x}); 50 | 51 | parse_err (2021, 2, 1, qq{"\n"}); 52 | parse_err (2022, 2, 1, qq{"\r"}); 53 | parse_err (2025, 2, 1, qq{"+ "}); 54 | parse_err (2026, 2, 1, qq{"\0 "}); 55 | parse_err (2027, 1, 1, '"'); 56 | parse_err (2031, 1, 1, qq{\r }); 57 | parse_err (2032, 2, 1, qq{ \r}); 58 | parse_err (2034, 4, 2, qq{1, "bar",2}); 59 | parse_err (2037, 1, 1, qq{\0 }); 60 | 61 | # Test error_diag in void context 62 | { my $e; 63 | #$csv.error_diag (); 64 | #ok (@warn == 1, "Got error message"); 65 | #like ($warn[0], qr{^# CSV ERROR: 2037 - EIF}, "error content"); 66 | } 67 | 68 | is ($csv.eof, False, "No EOF"); 69 | $csv.SetDiag (2012); 70 | is ($csv.eof, True, "EOF caused by 2012"); 71 | 72 | { my $e; 73 | ok (1, "Expecting an error line here:"); 74 | { Text::CSV.new (ecs_char => ":"); 75 | CATCH { default { $e = $_; }} 76 | } 77 | is (+$e, 1000, "unsupported attribute"); 78 | is (~$e, "INI - constructor failed: Unknown attribute 'ecs_char'", "Reported back"); 79 | } 80 | 81 | $csv.set_diag (1000); 82 | is (+$csv.error_diag, 1000, "1000 - Set error Num"); 83 | is (~$csv.error_diag, "INI - constructor failed", "1000 - Set error Str"); 84 | $csv.set-diag (0); 85 | is (+$csv.error_diag, 0, "Reset error Num"); 86 | is (~$csv.error_diag, "", "Reset error Str"); 87 | 88 | ok ($csv.parse (q{,cat,}), "Parse ASCII"); 89 | is (($csv.fields)[1].gist, q{qb7m-:"cat"}, "ASCII.gist"); 90 | ok ($csv.parse (q{"Ħēłĺº"}), "Parse UTF-8"); 91 | is (($csv.fields)[0].gist, q{QB8m-:"Ħēłĺº"}, "UTF-8.gist"); 92 | 93 | { my $csv = Text::CSV.new (); 94 | is ($csv.parse (q{1,"abc"}), True, "Valid parse"); 95 | is ($csv.error_input, Str, "No error_input"); 96 | is ($csv.error_diag.error, 0, "Error code"); 97 | is ($csv.error_diag.record, 1, "Error line"); 98 | is ($csv.error_diag.field, 0, "Error field"); 99 | is ($csv.error_diag.pos, 0, "Error pos"); 100 | is ($csv.parse (q{a"bc"}), False, "Invalid parse"); 101 | is ($csv.error_input, q{a"bc"}, "Error_input"); 102 | is ($csv.error_diag.error, 2034, "Error code"); 103 | is ($csv.error_diag.record, 2, "Error line"); 104 | is ($csv.error_diag.field, 1, "Error field"); 105 | is ($csv.error_diag.pos, 2, "Error pos"); 106 | } 107 | 108 | for (Str, # No spec at all 109 | "", # No spec at all 110 | "row=0", # row > 0 111 | "col=0", # col > 0 112 | "cell=0", # cell = r,c 113 | "cell=0,0", # col & row > 0 114 | "row=*", # * only after n- 115 | "col=3-1", # to >= from 116 | "cell=4,1;1", # cell has no ; 117 | "cell=3,3-2,1", # bottom-right should be right to and below top-left 118 | "cell=1,*", # * in single cell col 119 | "cell=*,1", # * in single cell row 120 | "cell=*,*", # * in single cell row and column 121 | "cell=1,*-8,9", # * in cell range top-left cell col 122 | "cell=*,1-8,9", # * in cell range top-left cell row 123 | "cell=*,*-8,9", # * in cell range top-left cell row and column 124 | "row=/", # illegal character 125 | "col=4;row=3", # cannot combine rows and columns 126 | ) -> $spec { 127 | my $csv = Text::CSV.new; 128 | my $e; 129 | my @r; 130 | { @r = $csv.fragment (Text::IO::String.new (""), $spec); 131 | CATCH { default { $e = $_; 1; }} 132 | } 133 | #$csv.error-diag; 134 | $e ||= $csv.error-diag; 135 | is (@r, [], "Cannot do fragment with bad RFC7111 spec"); 136 | is ($e.error, 2013, "Illegal RFC7111 spec ({$spec.perl})"); 137 | } 138 | 139 | { my $csv = Text::CSV.new (:strict); 140 | ok ($csv.parse ("1,2,3"), "Set strict to 3 columns"); 141 | ok ($csv.parse ("a,b,c"), "3 columns should be correct"); 142 | is ($csv.parse ("3,4"), False, "Not enough columns"); 143 | is (+$csv.error_diag, 2014, "Diag as expected"); 144 | } 145 | { my $csv = Text::CSV.new (:strict); 146 | ok ($csv.parse ("1,2,3"), "Set strict to 3 columns"); 147 | is ($csv.parse ("3,4,5,6"), False, "Too many columns"); 148 | is (+$csv.error_diag, 2014, "Diag as expected"); 149 | } 150 | 151 | done-testing; 152 | 153 | =finish 154 | 155 | ok (1, "Test auto_diag"); 156 | $csv = Text::CSV.new (:auto_diag); 157 | { my @warn; 158 | local $SIG{__WARN__} = sub { push @warn, @_ }; 159 | is ($csv.{_RECNO}, 0, "No records read yet"); 160 | is ($csv.parse ('"","'), 0, "1 - bad parse"); 161 | ok (@warn == 1, "1 - One error"); 162 | like ($warn[0], qr '^# CSV ERROR: 2027 -', "1 - error message"); 163 | is ($csv.{_RECNO}, 1, "One record read"); 164 | } 165 | { my @warn; 166 | local $SIG{__WARN__} = sub { push @warn, @_ }; 167 | is ($csv.diag_verbose (3), 3, "Set diag_verbose"); 168 | is ($csv.parse ('"","'), 0, "1 - bad parse"); 169 | ok (@warn == 1, "1 - One error"); 170 | @warn = split m/\n/ => $warn[0]; 171 | ok (@warn == 3, "1 - error plus two lines"); 172 | like ($warn[0], qr '^# CSV ERROR: 2027 -', "1 - error message"); 173 | like ($warn[1], qr '^"","', "1 - input line"); 174 | like ($warn[2], qr '^ \^', "1 - position indicator"); 175 | is ($csv.{_RECNO}, 2, "Another record read"); 176 | } 177 | 178 | done-testing; 179 | -------------------------------------------------------------------------------- /test.pl: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | my $opt_v = %*ENV // 1; 4 | my $test = qq{,1,ab,"cd","e"0f","g,h","nl\nz"0i""""3",\r\n}; 5 | my @rslt = ("", "1", "ab", "cd", "e\c0f", "g,h", qq{nl\nz\c0i""3}, ""); 6 | 7 | sub progress (*@y) { 8 | my Str $x; 9 | my @x = @y.map(*.Str); 10 | my $line = callframe(1).annotations; 11 | for (@x) { 12 | s{^(\d+)$} = sprintf "%3d -", $_; 13 | s:g{"True,"} = "True, "; 14 | s:g{"new("} = "new ("; 15 | $x ~= $_ ~ " "; 16 | } 17 | $x.say; 18 | } # progress 19 | 20 | class CSV::Field { 21 | 22 | has Bool $.is_quoted is rw = False; 23 | # has Bool $.is_binary is rw = False; 24 | # has Bool $.is_utf8 is rw = False; 25 | has Bool $.undefined is rw = True; 26 | # text last for formatted output of .perl (for now) 27 | has Str $.text is rw; 28 | 29 | enum Type < NA INT NUM STR BOOL >; 30 | 31 | method add (Str $chunk) { 32 | $!text ~= $chunk; 33 | $!undefined = False; 34 | } # add 35 | 36 | method set_quoted () { 37 | $!is_quoted = True; 38 | $!undefined = False; 39 | self.add(""); 40 | } 41 | 42 | } # CSV::Field 43 | 44 | class Text::CSV { 45 | 46 | has Str $.eol is rw; # = ($*IN.newline), 47 | has Str $.sep is rw = ','; 48 | has Str $.quo is rw = '"'; 49 | has Str $.esc is rw = '"'; 50 | 51 | has Bool $.binary is rw = True; # default changed 52 | has Bool $.decode_utf8 is rw = True; 53 | has Bool $.auto_diag is rw = False; 54 | has Bool $.diag_verbose is rw = False; 55 | 56 | has Bool $.blank_is_undef is rw = False; 57 | has Bool $.empty_is_undef is rw = False; 58 | has Bool $.allow_whitespace is rw = False; 59 | has Bool $.allow_loose_quotes is rw = False; 60 | has Bool $.allow_loose_escapes is rw = False; 61 | has Bool $.always_quote is rw = False; 62 | has Bool $.quote_space is rw = True; 63 | has Bool $.quote_null is rw = True; 64 | has Bool $.quote_binary is rw = True; 65 | has Bool $.keep_meta_info is rw = False; 66 | has Bool $.verbatim is rw; # Should die! 67 | 68 | has @!fields; 69 | has @!types; 70 | has @!callbacks; 71 | method compose { 72 | # A scoping bug in raku inhibits the use of $!eol inside the split 73 | my $eol = $!eol // rx{ \r\n | \r | \n }; 74 | my Str $sep = $!sep; 75 | my Str $quo = $!quo; 76 | my Str $esc = $!esc; 77 | rx{ $eol | $sep | $quo | $esc } 78 | }; 79 | has $!regex = self.compose(); 80 | 81 | method parse (Str $buffer) { 82 | 83 | my $field; 84 | my Int $pos = 0; 85 | 86 | my sub parse_error (Str $reason, *@args) { 87 | my $msg = $reason.sprintf(@args); 88 | die "$msg\n$buffer\n" ~ ' ' x $pos ~ "^\n"; 89 | } 90 | 91 | $opt_v > 8 and say $buffer.perl; 92 | ## A scoping bug in raku inhibits the use of $!eol inside the split 93 | #for $buffer.split(rx{ $!eol | $!sep | $!quo | $!esc }, :all).map(~*) -> Str $chunk { 94 | my $eol = $!eol // rx{ \r\n | \r | \n }; 95 | my Str $sep := $!sep; 96 | my Str $quo := $!quo; 97 | my Str $esc := $!esc; 98 | my $regex := $!regex; 99 | my $f = CSV::Field.new; 100 | 101 | @!fields = (); 102 | 103 | sub keep { 104 | # Set is_binary 105 | # Set is_utf8 106 | @!fields.push($f); 107 | $f = CSV::Field.new; 108 | } # add 109 | 110 | my @ch = $buffer.split($regex,:v).flat.map: { 111 | if $_ ~~ Str { 112 | $_ if .chars; 113 | } 114 | else { 115 | .Str if .Bool; 116 | }; 117 | } 118 | 119 | my int $skip; 120 | my int $i = -1; 121 | 122 | for @ch -> Str $chunk { 123 | $i = $i + 1; 124 | 125 | if $skip { 126 | $skip = 0; 127 | next; 128 | } 129 | 130 | $opt_v > 8 and progress($i, "###", "'$chunk'", $f.perl); 131 | 132 | if $chunk ~~ rx{^ $eol $} { 133 | $opt_v > 5 and progress($i, "EOL"); 134 | if $f.is_quoted { # 1,"2\n3" 135 | $f.add($chunk); 136 | next; 137 | } 138 | keep; 139 | return @!fields; 140 | } 141 | 142 | if $chunk eq $sep { 143 | $opt_v > 5 and progress($i, "SEP"); 144 | if $f.is_quoted { # "1,2" 145 | $f.add($chunk); 146 | next; 147 | } 148 | keep; # 1,2 149 | next; 150 | } 151 | 152 | if $chunk eq $quo { 153 | $opt_v > 5 and progress($i, "QUO", $f.perl); 154 | 155 | if $f.undefined { 156 | $f.set_quoted; 157 | next; 158 | } 159 | 160 | if $f.is_quoted { 161 | 162 | if $i + 1 >= @ch.elems { 163 | keep; 164 | return @!fields; 165 | } 166 | 167 | my Str $next = @ch[$i + 1]; 168 | 169 | if $next ~~ /^ $eol $/ { 170 | keep; 171 | return @!fields; 172 | } 173 | 174 | $opt_v > 8 and progress($i, "QUO", "next = $next"); 175 | 176 | if $next eq $sep { # "1", 177 | $opt_v > 7 and progress($i, "SEP"); 178 | $skip = 1; 179 | keep; 180 | next; 181 | } 182 | 183 | if $esc eq $quo { 184 | $opt_v > 7 and progress($i, "ESC", "($next)"); 185 | if $next ~~ /^ "0"/ { 186 | @ch[$i + 1] ~~ s{^ "0"} = ""; 187 | $opt_v > 8 and progress($i, "Add NIL"); 188 | $f.add("\c0"); 189 | next; 190 | } 191 | if $next eq $quo { 192 | $skip = 1; 193 | } 194 | } 195 | 196 | $f.add($chunk); 197 | next; 198 | } 199 | keep; 200 | next; 201 | } 202 | 203 | if $chunk eq $esc { 204 | $opt_v > 5 and progress($i, "ESC", $f.perl); 205 | } 206 | 207 | $chunk ne "" and $f.add($chunk); 208 | $pos += $chunk.chars; 209 | } 210 | 211 | keep; 212 | return @!fields; 213 | } # parse 214 | 215 | method getline () { 216 | return @!fields; 217 | } # getline 218 | } 219 | 220 | sub MAIN () { 221 | 222 | my $csv_parser = Text::CSV.new; 223 | 224 | $opt_v > 1 and say $csv_parser.perl; 225 | $opt_v and progress(.perl) for $csv_parser.parse($test); 226 | $opt_v and Qw { Expected: Str 1 ab cd e\0f g,h nl\nz\0i""3 Str }.say; 227 | 228 | my Int $sum = 0; 229 | for lines() { 230 | my @r = $csv_parser.parse($_); 231 | $sum += +@r; 232 | } 233 | $sum.say; 234 | } 235 | -------------------------------------------------------------------------------- /t/79_callbacks.t: -------------------------------------------------------------------------------- 1 | #!raku 2 | 3 | use v6; 4 | use Slang::Tuxic; 5 | 6 | use Test; 7 | use Text::CSV; 8 | 9 | my $tfn = "_79_callbacks.csv"; 10 | 11 | my $csv = Text::CSV.new (:meta); 12 | 13 | is ($csv.callbacks.keys.elems, 0, "No callbacks"); 14 | is ($csv.callbacks (0).keys.elems, 0, "Reset no callbacks"); 15 | is ($csv.callbacks (Hash).keys.elems, 0, "Reset no callbacks"); 16 | is ($csv.callbacks (Array).keys.elems, 0, "Reset no callbacks"); 17 | is ($csv.callbacks (False).keys.elems, 0, "Reset no callbacks"); 18 | is ($csv.callbacks ("reset").keys.elems, 0, "Reset no callbacks"); 19 | is ($csv.callbacks ("clear").keys.elems, 0, "Reset no callbacks"); 20 | is ($csv.callbacks ("RESET").keys.elems, 0, "Reset no callbacks"); 21 | is ($csv.callbacks ("CLEAR").keys.elems, 0, "Reset no callbacks"); 22 | 23 | ok ($csv = Text::CSV.new (callbacks => 0), "new with empty callbacks"); 24 | ok ($csv = Text::CSV.new (callbacks => Hash), "new with empty callbacks"); 25 | ok ($csv = Text::CSV.new (callbacks => Array), "new with empty callbacks"); 26 | ok ($csv = Text::CSV.new (callbacks => False), "new with empty callbacks"); 27 | ok ($csv = Text::CSV.new (callbacks => "reset"), "new with empty callbacks"); 28 | ok ($csv = Text::CSV.new (callbacks => "clear"), "new with empty callbacks"); 29 | ok ($csv = Text::CSV.new (callbacks => "RESET"), "new with empty callbacks"); 30 | ok ($csv = Text::CSV.new (callbacks => "CLEAR"), "new with empty callbacks"); 31 | 32 | sub Empty (CSV::Row $r) {} 33 | sub Drop (CSV::Row $r) { $r.fields.pop; } 34 | sub Push (CSV::Row $r) { $r.fields.push (CSV::Field.new); } 35 | sub Replc (CSV::Row $r) { $r.fields[1] = CSV::Field.new; } 36 | sub Unshf (CSV::Row $r) { $r.fields.unshift (CSV::Field.new ("0")); } 37 | 38 | ok ($csv.meta (True), "Set meta again"); 39 | is-deeply ([$csv.getline ("1,2").map (~*)], ["1","2"], "Parse no cb"); 40 | ok ($csv.callbacks ("after_parse", &Empty), "Empty ap cb"); 41 | is-deeply ([$csv.getline ("1,2").map (~*)], ["1","2"], "Parse empty cb"); 42 | ok ($csv.callbacks ("after_parse", &Drop), "Drop ap cb"); 43 | is-deeply ([$csv.getline ("1,2").map (~*)], ["1"], "Parse dropping cb"); 44 | ok ($csv.callbacks ("after_parse", &Push), "Push ap cb"); 45 | is-deeply ([$csv.getline ("1,2").map (~*)], ["1","2",Str], "Parse pushing cb"); 46 | ok ($csv.callbacks ("after_parse", &Replc), "Replc ap cb"); 47 | is-deeply ([$csv.getline ("1,2").map (~*)], ["1",Str], "Parse pushing cb"); 48 | ok ($csv.callbacks ("after_parse", &Unshf), "Unshf ap cb"); 49 | is-deeply ([$csv.getline ("1,2").map (~*)], ["0","1","2"], "Parse unshifting cb"); 50 | 51 | my $fh = open $tfn, :w; 52 | $fh.say: "1,a"; 53 | $fh.say: "2,b"; 54 | $fh.say: "3,c"; 55 | $fh.say: "4,d"; 56 | $fh.say: "5,e"; 57 | $fh.say: "6,f"; 58 | $fh.say: "7,g"; 59 | $fh.close; 60 | 61 | $fh = open $tfn, :r; 62 | sub Filter (CSV::Row $r) returns Bool { +$r[0] % 2 && $r[1] ~~ /^ <[abcd]> / ?? True !! False }; 63 | $csv = Text::CSV.new; 64 | ok ($csv.callbacks ("filter", &Filter), "Add filer"); 65 | ok ((my @r = $csv.getline_all ($fh)), "Fetch all with filter"); 66 | for @r -> @f { $_ = ~$_ for @f; } 67 | is-deeply (@r, [["1","a"],["3","c"]], "Filtered content"); 68 | $fh.close; 69 | 70 | $fh = open $tfn, :w; 71 | $fh.say: '1,2,3'; # 1 72 | $fh.say: ''; # 2 73 | $fh.say: ','; # 3 74 | $fh.say: '""'; # 4 75 | $fh.say: ',,'; # 5 76 | $fh.say: ', ,'; # 6 77 | $fh.say: '"",'; # 7 78 | $fh.say: '" "'; # 8 79 | $fh.say: '4,5,6'; # 9 80 | $fh.close; 81 | 82 | $fh = open $tfn, :r; 83 | $csv = Text::CSV.new; 84 | ok ($csv.callbacks ("filter", "not_blank"), "Add filer not_blank"); 85 | ok ((@r = $csv.getline_all ($fh)), "Fetch all with filter"); 86 | for @r -> @f { $_ = ~$_ for @f; } 87 | is-deeply (@r, [["1", "2", "3"], ["", ""], [""], ["", "", ""], ["", " ", ""], 88 | ["", ""], [" "], ["4", "5", "6"]], "Filtered content"); 89 | $fh.close; 90 | 91 | $fh = open $tfn, :r; 92 | $csv = Text::CSV.new; 93 | ok ($csv.callbacks ("filter", "not_empty"), "Add filer not_empty"); 94 | ok ((@r = $csv.getline_all ($fh)), "Fetch all with filter"); 95 | for @r -> @f { $_ = ~$_ for @f; } 96 | is-deeply (@r, [["1", "2", "3"], ["", " ", ""], [" "], 97 | ["4", "5", "6"]], "Filtered content"); 98 | $fh.close; 99 | $fh = open $tfn, :r; 100 | $csv = Text::CSV.new; 101 | ok ($csv.callbacks ("filter", "not-empty"), "Add filer not-empty"); 102 | ok ((@r = $csv.getline_all ($fh)), "Fetch all with filter"); 103 | for @r -> @f { $_ = ~$_ for @f; } 104 | is-deeply (@r, [["1", "2", "3"], ["", " ", ""], [" "], 105 | ["4", "5", "6"]], "Filtered content"); 106 | $fh.close; 107 | 108 | $fh = open $tfn, :r; 109 | $csv = Text::CSV.new; 110 | ok ($csv.callbacks ("filter", "filled"), "Add filer filled"); 111 | ok ((@r = $csv.getline_all ($fh)), "Fetch all with filter"); 112 | for @r -> @f { $_ = ~$_ for @f; } 113 | is-deeply (@r, [["1", "2", "3"], ["4", "5", "6"]], "Filtered content"); 114 | $fh.close; 115 | 116 | unlink $tfn; 117 | 118 | # These tests are for the method to fail 119 | ok ($csv = Text::CSV.new, "new for method fails"); 120 | for ([ 1 ], 121 | [ $[] ], 122 | [ sub {} ], 123 | [ 1, 2 ], 124 | [ 1, 2, 3 ], 125 | [ "", "error" ], 126 | [ Str, "error" ], # X::AdHoc.new 127 | [ "error", Str ], 128 | [ "%23bad", sub {} ], # X::AdHoc.new 129 | [ "error", $[] ], 130 | [ "error", "error" ], 131 | [ "", sub { 0; } ], 132 | [ sub { 0; }, 0 ], # Code object coerced to string 133 | [ $[], "" ], 134 | [ "error", sub {0; }, Str, 1 ], 135 | ) -> @args { 136 | my $e; 137 | ok (True, "Callbacks: "~@args.perl); 138 | { $csv.callbacks (@args); 139 | CATCH { default { $e = $_; ""; }} 140 | } 141 | is ($e.error, any (1004, 3100), "invalid callbacks: "~$e.error); 142 | is ($csv.callbacks.keys.elems, 0, "not set"); 143 | } 144 | 145 | done-testing; 146 | 147 | =finish 148 | 149 | # These tests are for invalid arguments *inside* the hash 150 | foreach my $arg (undef, 0, 1, \1, "", [], $csv) { 151 | eval { $csv->callbacks ({ error => $arg }); }; 152 | my @diag = $csv->error_diag; 153 | is ($diag[0], 1004, "invalid callbacks"); 154 | is ($csv->callbacks, undef, "not set"); 155 | } 156 | ok ($csv->callbacks (bogus => sub { 0; }), "useless callback"); 157 | 158 | my $error = 3006; 159 | sub ignore 160 | { 161 | is ($_[0], $error, "Caught error $error"); 162 | $csv->SetDiag (0); # Ignore this error 163 | } # ignore 164 | 165 | my $idx = 1; 166 | ok ($csv->auto_diag (1), "set auto_diag"); 167 | my $callbacks = { 168 | error => \&ignore, 169 | after_parse => sub { 170 | my ($c, $av) = @_; 171 | # Just add a field 172 | push @$av, "NEW"; 173 | }, 174 | before_print => sub { 175 | my ($c, $av) = @_; 176 | # First field set to line number 177 | $av->[0] = $idx++; 178 | # Maximum 2 fields 179 | @{$av} > 2 and splice @{$av}, 2; 180 | # Minimum 2 fields 181 | @{$av} < 2 and push @{$av}, ""; 182 | }, 183 | }; 184 | is (ref $csv->callbacks ($callbacks), "HASH", "callbacks set"); 185 | ok ($csv->getline (*DATA), "parse ok"); 186 | is ($c, 1, "key"); 187 | is ($s, "foo", "value"); 188 | ok ($csv->getline (*DATA), "parse bad, skip 3006"); 189 | ok ($csv->getline (*DATA), "parse good"); 190 | is ($c, 2, "key"); 191 | is ($s, "bar", "value"); 192 | 193 | $csv->bind_columns (undef); 194 | ok (my $row = $csv->getline (*DATA), "get row"); 195 | is-deeply ($row, [ 1, 2, 3, "NEW" ], "fetch + value from hook"); 196 | 197 | $error = 2012; # EOF 198 | ok ($csv->getline (*DATA), "parse past eof"); 199 | 200 | my $fn = "_79test.csv"; 201 | END { unlink $fn; } 202 | 203 | ok ($csv->eol ("\n"), "eol for output"); 204 | open my $fh, ">", $fn or die "$fn: $!"; 205 | ok ($csv->print ($fh, [ 0, "foo" ]), "print OK"); 206 | ok ($csv->print ($fh, [ 0, "bar", 3 ]), "print too many"); 207 | ok ($csv->print ($fh, [ 0 ]), "print too few"); 208 | close $fh; 209 | 210 | open $fh, "<", $fn or die "$fn: $!"; 211 | is (do { local $/; <$fh> }, "1,foo\n2,bar\n3,\n", "Modified output"); 212 | close $fh; 213 | 214 | # Test the non-IO interface 215 | ok ($csv->parse ("10,blah,33\n"), "parse"); 216 | is-deeply ([ $csv->fields ], [ 10, "blah", 33, "NEW" ], "fields"); 217 | 218 | ok ($csv->combine (11, "fri", 22, 18), "combine - no hook"); 219 | is ($csv->string, qq{11,fri,22,18\n}, "string"); 220 | 221 | is ($csv->callbacks (undef), undef, "clear callbacks"); 222 | 223 | is-deeply (Text::CSV_XS::csv (in => $fn, callbacks => $callbacks), 224 | [[1,"foo","NEW"],[2,"bar","NEW"],[3,"","NEW"]], "using getline_all"); 225 | 226 | done-testing; 227 | 228 | __END__ 229 | 1,foo 230 | 1 231 | foo 232 | 2,bar 233 | 3,baz,2 234 | 1,foo 235 | 3,baz,2 236 | 2,bar 237 | 1,2,3 238 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2015, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | --------------------------------------------------------------------------------