Репозитории ALT
Группа :: Разработка/Perl
Пакет: perl-Text-CSV_XS
навигация по пакетам
Главная Изменения Спек Патчи Исходники Загрузить Gear Bugs and FR Repocop
pax_global_header 0000666 0000000 0000000 00000000064 10611542315 0014510 g ustar 00root root 0000000 0000000 52 comment=6a2b786fad9a5af8b5bb66573a0d8ca346a9c4b3
Text-CSV_XS-0.23-alt2/ 0000755 0000000 0000000 00000000000 10611542315 0014261 5 ustar 00root root 0000000 0000000 Text-CSV_XS-0.23-alt2/.gear-rules 0000644 0000000 0000000 00000000054 10611542315 0016327 0 ustar 00root root 0000000 0000000 tar: . name=Text-CSV_XS-@version@-@release@
Text-CSV_XS-0.23-alt2/CSV_XS.pm 0000644 0000000 0000000 00000037446 10611542315 0015702 0 ustar 00root root 0000000 0000000 package Text::CSV_XS;
# Copyright (c) 1998 Jochen Wiedmann. All rights reserved.
#
# Portions Copyright (c) 1997 Alan Citterman. All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
################################################################################
# HISTORY
#
# Written by:
# Jochen Wiedmann <joe@ispsoft.de>
#
# Based on Text::CSV by:
# Alan Citterman <alan@mfgrtl.com>
#
############################################################################
require 5.004;
use strict;
our $VERSION = '0.23';
require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);
sub PV () { 0 }
sub IV () { 1 }
sub NV () { 2 }
############################################################################
#
# version
#
# class/object method expecting no arguments and returning the version
# number of Text::CSV. there are no side-effects.
#
############################################################################
sub version {
return $VERSION;
}
############################################################################
#
# new
#
# class/object method expecting no arguments and returning a reference to
# a newly created Text::CSV object.
#
############################################################################
sub new ($;$) {
my $proto = shift; my $attr = shift || {};
my $class = ref($proto) || $proto;
my $self = { 'quote_char' => '"',
'escape_char' => '"',
'sep_char' => ',',
'eol' => '',
%$attr };
bless $self, $class;
if (exists($self->{'types'})) {
$self->types($self->{'types'});
}
$self;
}
############################################################################
#
# status
#
# object method returning the success or failure of the most recent
# combine() or parse(). there are no side-effects.
############################################################################
sub status ($) {
my $self = shift;
return $self->{'_STATUS'};
}
############################################################################
#
# error_input
#
# object method returning the first invalid argument to the most recent
# combine() or parse(). there are no side-effects.
############################################################################
sub error_input ($) {
my $self = shift;
return $self->{'_ERROR_INPUT'};
}
############################################################################
#
# string
#
# object method returning the result of the most recent combine() or the
# input to the most recent parse(), whichever is more recent. there are
# no side-effects.
#
############################################################################
sub string ($) {
my $self = shift;
return $self->{'_STRING'};
}
############################################################################
# fields
#
# object method returning the result of the most recent parse() or the
# input to the most recent combine(), whichever is more recent. there
# are no side-effects.
#
############################################################################
sub fields ($) {
my $self = shift;
if (ref($self->{'_FIELDS'})) {
return @{$self->{'_FIELDS'}};
}
return undef;
}
############################################################################
#
# combine
#
# object method returning success or failure. the given arguments are
# combined into a single comma-separated value. failure can be the
# result of no arguments or an argument containing an invalid character.
# side-effects include:
# setting status()
# setting fields()
# setting string()
# setting error_input()
#
############################################################################
sub combine ($@) {
my $self = shift;
my @part = @_;
my($str) = '';
my($ref) = \$str;
$self->{'_FIELDS'} = \@part;
$self->{'_ERROR_INPUT'} = undef;
$self->{'_STATUS'} =
(@part > 0) && $self->Encode(\$str, \@part, 0, $self->{'eol'});
$self->{'_STRING'} = $str;
$self->{'_STATUS'};
}
############################################################################
#
# parse
#
# object method returning success or failure. the given argument is
# expected to be a valid comma-separated value. failure can be the
# result of no arguments or an argument containing an invalid sequence
# of characters. side-effects include:
# setting status()
# setting fields()
# setting string()
# setting error_input()
#
#############################################################################
sub parse ($$) {
my($self, $str) = @_;
my($fields) = [];
$self->{'_STRING'} = $self->{'ERROR_INPUT'} = $str;
$self->{'_STATUS'} = 0;
$self->{'_FIELDS'} = undef;
if (defined($str) && $self->Decode($str, $fields, 0)) {
$self->{'_FIELDS'} = $fields;
$self->{'_STATUS'} = 1;
}
return ($self->{'_STATUS'});
}
############################################################################
#
# Name: print (Instance method)
#
# Purpose: Similar to combine, but the fields are encoded to an
# IO stream or something similar. To be precise: An
# object supporting a "print" method.
#
# Inputs: $self - Instance
# $io - IO handle or similar object
# $fields - Array ref to array of fields
#
# Returns: TRUE for success, FALSE otherwise. In the latter case
# you may look at $self->error_input() or check the IO
# object for errors.
#
############################################################################
# sub print ($$$) {
# my($self, $io, $fields) = @_;
# $self->{'_ERROR_INPUT'} = undef;
# $self->{'_STRING'} = undef;
# $self->{'_FIELDS'} = $fields;
# $self->{'_STATUS'} = $self->Encode($io, $fields, 1, $self->{'eol'});
# }
############################################################################
#
# Name: getline (Instance method)
#
# Purpose: Similar to parse, but the fields are decoded from an
# IO stream or something similar. To be precise: An
# object supporting a "getline" method.
#
# Note that it may happen that multiple lines are read,
# if the fields contain line feeds and we are in binary
# mode. For example, MS Excel creates such files!
#
# Inputs: $self - Instance
# $io - IO handle or similar object
#
# Returns: Array ref of fields for success, undef otherwise.
# In the latter case you may look at $self->error_input()
# or check the IO object for errors.
#
############################################################################
# sub getline ($$) {
# my($self, $io) = @_;
# my($fields) = [];
# $self->{'_ERROR_INPUT'} = undef;
# $self->{'_STRING'} = undef;
# $self->{'_FIELDS'} = $fields;
# if ($self->{'_STATUS'} = $self->Decode($io, $fields, 1)) {
# return $fields;
# }
# return undef;
# }
sub types {
my $self = shift;
if (@_) {
if (my $types = shift) {
$self->{'_types'} = join("", map{ chr($_) } @$types);
$self->{'types'} = $types;
} else {
delete $self->{'types'};
delete $self->{'_types'};
undef;
}
} else {
$self->{'types'};
}
}
1;
__END__
=head1 NAME
Text::CSV_XS - comma-separated values manipulation routines
=head1 SYNOPSIS
use Text::CSV_XS;
$csv = Text::CSV_XS->new(); # create a new object
$csv = Text::CSV_XS->new(\%attr); # create a new object
$status = $csv->combine(@columns); # combine columns into a string
$line = $csv->string(); # get the combined string
$status = $csv->parse($line); # parse a CSV string into fields
@columns = $csv->fields(); # get the parsed fields
$status = $csv->status(); # get the most recent status
$bad_argument = $csv->error_input(); # get the most recent bad argument
$status = $csv->print($io, $columns); # Write an array of fields immediately
# to a file $io
$columns = $csv->getline($io); # Read a line from file $io, parse it
# and return an array ref of fields
$csv->types(\@t_array); # Set column types
=head1 DESCRIPTION
Text::CSV_XS provides facilities for the composition and decomposition of
comma-separated values. An instance of the Text::CSV_XS class can combine
fields into a CSV string and parse a CSV string into fields.
=head1 FUNCTIONS
=over 4
=item version()
(Class method) Returns the current module version.
=item new(\%attr)
(Class method) Returns a new instance of Text::CSV_XS. The objects
attributes are described by the (optional) hash ref C<\%attr>.
Currently the following attributes are available:
=over 8
=item quote_char
The char used for quoting fields containing blanks, by default the
double quote character (C<">). A value of undef suppresses
quote chars. (For simple cases only).
=item eol
An end-of-line string to add to rows, usually C<undef> (nothing,
default), C<"\012"> (Line Feed) or C<"\015\012"> (Carriage Return,
Line Feed)
=item escape_char
The char used for escaping certain characters inside quoted fields,
by default the same character. (C<">)
=item sep_char
The char used for separating fields, by default a comme. (C<,>)
=item binary
If this attribute is TRUE, you may use binary characters in quoted fields,
including line feeds, carriage returns and NUL bytes. (The latter must
be escaped as C<"0>.) By default this feature is off.
=item types
A set of column types; this attribute is immediately passed to the
I<types> method below. You must not set this attribute otherwise,
except for using the I<types> method. For details see the description
of the I<types> method below.
=item always_quote
By default the generated fields are quoted only, if they need to, for
example, if they contain the separator. If you set this attribute to
a TRUE value, then all fields will be quoted. This is typically easier
to handle in external applications. (Poor creatures who aren't using
Text::CSV_XS. :-)
=back
To sum it up,
$csv = Text::CSV_XS->new();
is equivalent to
$csv = Text::CSV_XS->new({
'quote_char' => '"',
'escape_char' => '"',
'sep_char' => ',',
'binary' => 0
});
=item combine
$status = $csv->combine(@columns);
This object function constructs a CSV string from the arguments, returning
success or failure. Failure can result from lack of arguments or an argument
containing an invalid character. Upon success, C<string()> can be called to
retrieve the resultant CSV string. Upon failure, the value returned by
C<string()> is undefined and C<error_input()> can be called to retrieve an
invalid argument.
=item print
$status = $csv->print($io, $columns);
Similar to combine, but it expects an array ref as input (not an array!)
and the resulting string is not really created, but immediately written
to the I<$io> object, typically an IO handle or any other object that
offers a I<print> method. Note, this implies that the following is wrong:
open(FILE, ">whatever");
$status = $csv->print(\*FILE, $columns);
The glob C<\*FILE> is not an object, thus it doesn't have a print
method. The solution is to use an IO::File object or to hide the
glob behind an IO::Wrap object. See L<IO::File(3)> and L<IO::Wrap(3)>
for details.
For performance reasons the print method doesn't create a result string.
In particular the I<$csv-E<gt>string()>, I<$csv-E<gt>status()>,
I<$csv->fields()> and I<$csv-E<gt>error_input()> methods are meaningless
after executing this method.
=item string
$line = $csv->string();
This object function returns the input to C<parse()> or the resultant CSV
string of C<combine()>, whichever was called more recently.
=item parse
$status = $csv->parse($line);
This object function decomposes a CSV string into fields, returning
success or failure. Failure can result from a lack of argument or the
given CSV string is improperly formatted. Upon success, C<fields()> can
be called to retrieve the decomposed fields . Upon failure, the value
returned by C<fields()> is undefined and C<error_input()> can be called
to retrieve the invalid argument.
You may use the I<types()> method for setting column types. See the
description below.
=item getline
$columns = $csv->getline($io);
This is the counterpart to print, like parse is the counterpart to
combine: It reads a row from the IO object $io using $io->getline()
and parses this row into an array ref. This array ref is returned
by the function or undef for failure.
The I<$csv-E<gt>string()>, I<$csv-E<gt>fields()> and I<$csv-E<gt>status()>
methods are meaningless, again.
=item types
$csv->types(\@tref);
This method is used to force that columns are of a given type. For
example, if you have an integer column, two double columns and a
string column, then you might do a
$csv->types([Text::CSV_XS::IV(),
Text::CSV_XS::NV(),
Text::CSV_XS::NV(),
Text::CSV_XS::PV()]);
Column types are used only for decoding columns, in other words
by the I<parse()> and I<getline()> methods.
You can unset column types by doing a
$csv->types(undef);
or fetch the current type settings with
$types = $csv->types();
=item fields
@columns = $csv->fields();
This object function returns the input to C<combine()> or the resultant
decomposed fields of C<parse()>, whichever was called more recently.
=item status
$status = $csv->status();
This object function returns success (or failure) of C<combine()> or
C<parse()>, whichever was called more recently.
=item error_input
$bad_argument = $csv->error_input();
This object function returns the erroneous argument (if it exists) of
C<combine()> or C<parse()>, whichever was called more recently.
=back
=head1 EXAMPLE
require Text::CSV_XS;
my $csv = Text::CSV_XS->new;
my $column = '';
my $sample_input_string = '"I said, ""Hi!""",Yes,"",2.34,,"1.09"';
if ($csv->parse($sample_input_string)) {
my @field = $csv->fields;
my $count = 0;
for $column (@field) {
print ++$count, " => ", $column, "\n";
}
print "\n";
} else {
my $err = $csv->error_input;
print "parse() failed on argument: ", $err, "\n";
}
my @sample_input_fields = ('You said, "Hello!"',
5.67,
'Surely',
'',
'3.14159');
if ($csv->combine(@sample_input_fields)) {
my $string = $csv->string;
print $string, "\n";
} else {
my $err = $csv->error_input;
print "combine() failed on argument: ", $err, "\n";
}
=head1 CAVEATS
This module is based upon a working definition of CSV format which may not be
the most general.
=over 4
=item 1
Allowable characters within a CSV field include 0x09 (tab) and the inclusive
range of 0x20 (space) through 0x7E (tilde). In binary mode all characters
are accepted, at least in quoted fields:
=item 2
A field within CSV may be surrounded by double-quotes. (The quote char)
=item 3
A field within CSV must be surrounded by double-quotes to contain a comma.
(The separator char)
=item 4
A field within CSV must be surrounded by double-quotes to contain an embedded
double-quote, represented by a pair of consecutive double-quotes. In binary
mode you may additionally use the sequence C<"0> for representation of a
NUL byte.
=item 5
A CSV string may be terminated by 0x0A (line feed) or by 0x0D,0x0A
(carriage return, line feed).
=head1 AUTHOR
Alan Citterman F<E<lt>alan@mfgrtl.comE<gt>> wrote the original Perl
module. Please don't send mail concerning Text::CSV_XS to Alan, as
he's not involved in the C part which is now the main part of the
module.
Jochen Wiedmann F<E<lt>joe@ispsoft.deE<gt>> rewrote the encoding and
decoding in C by implementing a simple finite-state machine and added
the variable quote, escape and separator characters, the binary mode
and the print and getline methods.
=head1 SEE ALSO
L<perl(1)>, L<IO::File(3)>, L<IO::Wrap(3)>
=cut
Text-CSV_XS-0.23-alt2/CSV_XS.xs 0000644 0000000 0000000 00000033416 10611542315 0015711 0 ustar 00root root 0000000 0000000 /* -*- C -*-
*
* Copyright (c) 1998 Jochen Wiedmann. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
*
**************************************************************************/
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include "ppport.h"
#define CSV_XS_TYPE_PV 0
#define CSV_XS_TYPE_IV 1
#define CSV_XS_TYPE_NV 2
#define CSV_XS_SELF \
if (!self || !SvOK(self) || !SvROK(self) \
|| SvTYPE(SvRV(self)) != SVt_PVHV) { \
croak("self is not a hash ref"); \
} \
hv = (HV*) SvRV(self);
typedef struct {
HV* self;
unsigned char quoteChar;
unsigned char escapeChar;
unsigned char sepChar;
int binary;
int alwaysQuote;
char buffer[1024];
STRLEN used;
STRLEN size;
char* bptr;
int useIO;
SV* tmp;
char* types;
STRLEN types_len;
} csv_t;
static void SetupCsv(csv_t* csv, HV* self) {
SV** svp;
STRLEN len;
char* ptr;
csv->quoteChar = '"';
if ((svp = hv_fetch(self, "quote_char", 10, 0)) && *svp) {
if (!SvOK(*svp)) {
csv->quoteChar = '\0';
} else {
ptr = SvPV(*svp, len);
csv->quoteChar = len ? *ptr : '\0';
}
}
csv->escapeChar = '"';
if ((svp = hv_fetch(self, "escape_char", 11, 0)) && *svp) {
if (!SvOK(*svp)) {
csv->escapeChar = '\0';
} else {
ptr = SvPV(*svp, len);
csv->escapeChar = len ? *ptr : '\0';
}
}
csv->sepChar = ',';
if ((svp = hv_fetch(self, "sep_char", 8, 0)) && *svp && SvOK(*svp)) {
ptr = SvPV(*svp, len);
if (len) {
csv->sepChar = *ptr;
}
}
csv->types = NULL;
if ((svp = hv_fetch(self, "_types", 6, 0)) && *svp && SvOK(*svp)) {
STRLEN len;
csv->types = SvPV(*svp, len);
csv->types_len = len;
}
csv->binary = 0;
if ((svp = hv_fetch(self, "binary", 6, 0)) && *svp) {
csv->binary = SvTRUE(*svp);
}
csv->alwaysQuote = 0;
if ((svp = hv_fetch(self, "always_quote", 12, 0)) && *svp) {
csv->alwaysQuote = SvTRUE(*svp);
}
csv->self = self;
csv->used = 0;
}
static
int Print(csv_t* csv, SV* dst) {
int result;
if (csv->useIO) {
SV* tmp = newSVpv(csv->buffer, csv->used);
dSP;
PUSHMARK(sp);
EXTEND(sp, 2);
PUSHs((dst));
PUSHs(tmp);
PUTBACK;
result = perl_call_method("print", G_SCALAR);
SPAGAIN;
if (result) {
result = POPi;
}
PUTBACK;
SvREFCNT_dec(tmp);
} else {
sv_catpvn(SvRV(dst), csv->buffer, csv->used);
result = TRUE;
}
csv->used = 0;
return result;
}
#define CSV_PUT(csv, dst, c) \
if ((csv)->used == sizeof((csv)->buffer)-1) { \
Print((csv), (dst)); \
} \
(csv)->buffer[(csv)->used++] = (c);
static int Encode(csv_t* csv, SV* dst, AV* fields, SV* eol) {
int i;
for (i = 0; i <= av_len(fields); i++) {
SV** svp;
if (i > 0) {
CSV_PUT(csv, dst, csv->sepChar);
}
if ((svp = av_fetch(fields, i, 0)) && *svp && SvOK(*svp)) {
STRLEN len;
char* ptr = SvPV(*svp, len);
int quoteMe = csv->alwaysQuote;
/*
* Do we need quoting? We do quote, if the user requested
* (alwaysQuote), if binary or blank characters are found
* and if the string contains quote or escape characters.
*/
if (!quoteMe &&
(quoteMe = (!SvIOK(*svp) && !SvNOK(*svp) &&
csv->quoteChar))) {
char* ptr2, *ptr3;
STRLEN l;
for (ptr2 = ptr, l = len; l; ++ptr2, --l) {
unsigned char c = *ptr2;
if (c <= 0x20 || (c >= 0x7f && c <= 0xa0) ||
(csv->quoteChar && c == csv->quoteChar) ||
(csv->sepChar && c == csv->sepChar) ||
(csv->escapeChar && c == csv->escapeChar)) {
/* Binary character */
break;
}
}
quoteMe = (l>0);
}
if (quoteMe) {
CSV_PUT(csv, dst, csv->quoteChar);
}
while (len-- > 0) {
char c = *ptr++;
int e = 0;
if (!csv->binary &&
(c != '\t' && (c < '\040' || c > '\176'))) {
SvREFCNT_inc(*svp);
if (!hv_store(csv->self, "_ERROR_INPUT", 12, *svp, 0)) {
SvREFCNT_dec(*svp);
}
return FALSE;
}
if (csv->quoteChar && c == csv->quoteChar) {
e = 1;
} else if (csv->escapeChar && c == csv->escapeChar) {
e = 1;
} else if (c == '\0') {
e = 1;
c = '0';
}
if (e && csv->escapeChar) {
CSV_PUT(csv, dst, csv->escapeChar);
}
CSV_PUT(csv, dst, c);
}
if (quoteMe) {
CSV_PUT(csv, dst, csv->quoteChar);
}
}
}
if (eol && SvOK(eol)) {
STRLEN len;
char* ptr = SvPV(eol, len);
while (len--) {
CSV_PUT(csv, dst, *ptr++);
}
}
if (csv->used) {
Print(csv, dst);
}
return TRUE;
}
static void DecodeError(csv_t* csv) {
if(csv->tmp) {
if (hv_store(csv->self, "_ERROR_INPUT", 12, csv->tmp, 0)) {
SvREFCNT_inc(csv->tmp);
}
}
}
static int CsvGet(csv_t* csv, SV* src) {
if (!csv->useIO) {
return EOF;
}
{
int result;
dSP;
PUSHMARK(sp);
EXTEND(sp, 1);
PUSHs(src);
PUTBACK;
result = perl_call_method("getline", G_SCALAR);
SPAGAIN;
if (result) {
csv->tmp = POPs;
} else {
csv->tmp = NULL;
}
PUTBACK;
}
if (csv->tmp && SvOK(csv->tmp)) {
csv->bptr = SvPV(csv->tmp, csv->size);
csv->used = 0;
if (csv->size) {
return ((unsigned char) csv->bptr[csv->used++]);
}
}
return EOF;
}
#define ERROR_INSIDE_QUOTES \
SvREFCNT_dec(insideQuotes); \
DecodeError(csv); \
return FALSE;
#define ERROR_INSIDE_FIELD \
SvREFCNT_dec(insideField); \
DecodeError(csv); \
return FALSE;
#define CSV_PUT_SV(sv, c) \
len = SvCUR((sv)); \
SvGROW((sv), len+2); \
*SvEND((sv)) = c; \
SvCUR_set((sv), len+1)
#define CSV_GET \
((c_ungetc != EOF) ? c_ungetc : \
((csv->used < csv->size) ? \
((unsigned char) csv->bptr[(csv)->used++]) : CsvGet(csv, src)))
#define AV_PUSH(fields, sv) \
*SvEND(sv) = '\0'; \
av_push(fields, sv);
static int Decode(csv_t* csv, SV* src, AV* fields) {
int c;
int c_ungetc = EOF;
int waitingForField = 1;
SV* insideQuotes = NULL;
SV* insideField = NULL;
STRLEN len;
int seenSomething = FALSE;
while ((c = CSV_GET) != EOF) {
seenSomething = TRUE;
restart:
if (c == csv->sepChar) {
if (waitingForField) {
av_push(fields, newSVpv("", 0));
} else if (insideQuotes) {
CSV_PUT_SV(insideQuotes, c);
} else {
AV_PUSH(fields, insideField);
insideField = NULL;
waitingForField = 1;
}
} else if (c == '\012') {
if (waitingForField) {
av_push(fields, newSVpv("", 0));
return TRUE;
} else if (insideQuotes) {
if (!csv->binary) {
ERROR_INSIDE_QUOTES;
}
CSV_PUT_SV(insideQuotes, c);
} else {
AV_PUSH(fields, insideField);
return TRUE;
}
} else if (c == '\015') {
if (waitingForField) {
int c2 = CSV_GET;
if (c2 == EOF) {
insideField = newSVpv("", 0);
waitingForField = 0;
goto restart;
} else if (c2 == '\012') {
c = '\012';
goto restart;
} else {
c_ungetc = c2;
insideField = newSVpv("", 0);
waitingForField = 0;
goto restart;
}
} else if (insideQuotes) {
if (!csv->binary) {
ERROR_INSIDE_QUOTES;
}
CSV_PUT_SV(insideQuotes, c);
} else {
int c2 = CSV_GET;
if (c2 == '\012') {
AV_PUSH(fields, insideField);
return TRUE;
} else {
ERROR_INSIDE_FIELD;
}
}
} else if (c == csv->quoteChar) {
if (waitingForField) {
insideQuotes = newSVpv("", 0);
waitingForField = 0;
} else if (insideQuotes) {
int c2;
if (!csv->escapeChar || c != csv->escapeChar) {
/* Field is terminated */
AV_PUSH(fields, insideQuotes);
insideQuotes = NULL;
waitingForField = 1;
c2 = CSV_GET;
if (c2 == csv->sepChar) {
continue;
} else if (c2 == EOF) {
return TRUE;
} else if (c2 == '\015') {
int c3 = CSV_GET;
if (c3 == '\012') {
return TRUE;
}
DecodeError(csv);
return FALSE;
} else if (c2 == '\012') {
return TRUE;
} else {
DecodeError(csv);
return FALSE;
}
}
c2 = CSV_GET;
if (c2 == EOF) {
AV_PUSH(fields, insideQuotes);
return TRUE;
} else if (c2 == csv->sepChar) {
AV_PUSH(fields, insideQuotes);
insideQuotes = NULL;
waitingForField = 1;
} else if (c2 == '0') {
CSV_PUT_SV(insideQuotes, (int) '\0');
} else if (c2 == csv->quoteChar || c2 == csv->sepChar) {
CSV_PUT_SV(insideQuotes, c2);
} else if (c2 == '\012') {
AV_PUSH(fields, insideQuotes);
return TRUE;
} else if (c2 == '\015') {
int c3 = CSV_GET;
if (c3 == '\012') {
AV_PUSH(fields, insideQuotes);
return TRUE;
}
ERROR_INSIDE_QUOTES;
} else {
ERROR_INSIDE_QUOTES;
}
} else if (csv->quoteChar && csv->quoteChar != csv->escapeChar) {
if (!csv->binary &&
(c != '\011' && (c < '\040' || c > '\176'))) {
ERROR_INSIDE_FIELD;
}
CSV_PUT_SV(insideField, c);
} else {
ERROR_INSIDE_FIELD;
}
} else if (csv->escapeChar && c == csv->escapeChar) {
/* This means quoteChar != escapeChar */
if (waitingForField) {
insideField = newSVpv("", 0);
waitingForField = 0;
} else if (insideQuotes) {
int c2 = CSV_GET;
if (c2 == EOF) {
ERROR_INSIDE_QUOTES;
} else if (c2 == '0') {
CSV_PUT_SV(insideQuotes, (int) '\0');
} else if (c2 == csv->quoteChar || c2 == csv->sepChar ||
c2 == csv->escapeChar) {
/* c2 == csv->escapeChar added 28-06-1999,
* Pavel Kotala <pkotala@logis.cz>
*/
CSV_PUT_SV(insideQuotes, c2);
} else {
ERROR_INSIDE_QUOTES;
}
} else if (insideField) {
int c2 = CSV_GET;
if (c2 == EOF) {
ERROR_INSIDE_FIELD;
} else {
CSV_PUT_SV(insideField, c2);
}
} else {
ERROR_INSIDE_FIELD;
}
} else {
if (waitingForField) {
insideField = newSVpv("", 0);
waitingForField = 0;
goto restart;
} else if (insideQuotes) {
if (!csv->binary &&
(c != '\011' && (c < '\040' || c > '\176'))) {
ERROR_INSIDE_QUOTES;
}
CSV_PUT_SV(insideQuotes, c);
} else {
if (!csv->binary &&
(c != '\011' && (c < '\040' || c > '\176'))) {
ERROR_INSIDE_FIELD;
}
CSV_PUT_SV(insideField, c);
}
}
}
if (waitingForField) {
if (seenSomething) {
av_push(fields, newSVpv("", 0));
}
} else if (insideQuotes) {
ERROR_INSIDE_QUOTES;
} else if (insideField) {
AV_PUSH(fields, insideField);
}
return TRUE;
}
static int xsDecode(HV* hv, AV* av, SV* src, bool useIO) {
csv_t csv;
int result;
SetupCsv(&csv, hv);
if ((csv.useIO = useIO)) {
csv.tmp = NULL;
csv.size = 0;
} else {
STRLEN size;
csv.tmp = src;
csv.bptr = SvPV(src, size);
csv.size = size;
}
result = Decode(&csv, src, av);
if (result && csv.types) {
I32 i, len = av_len(av);
SV** svp;
for (i = 0; i <= len && i <= csv.types_len; i++) {
if ((svp = av_fetch(av, i, 0)) && *svp && SvOK(*svp)) {
switch (csv.types[i]) {
case CSV_XS_TYPE_IV:
sv_setiv(*svp, SvIV(*svp));
break;
case CSV_XS_TYPE_NV:
sv_setnv(*svp, SvIV(*svp));
break;
}
}
}
}
return result;
}
static int xsEncode(HV* hv, AV* av, SV* io, bool useIO, SV* eol) {
csv_t csv;
SetupCsv(&csv, hv);
csv.useIO = useIO;
return Encode(&csv, io, av, eol);
}
MODULE = Text::CSV_XS PACKAGE = Text::CSV_XS
PROTOTYPES: ENABLE
SV*
Encode(self, dst, fields, useIO, eol)
SV* self
SV* dst
SV* fields
bool useIO
SV* eol
PROTOTYPE: $$$$
PPCODE:
{
HV* hv;
AV* av;
CSV_XS_SELF;
if (!fields || !SvOK(fields) || !SvROK(fields)
|| SvTYPE(SvRV(fields)) != SVt_PVAV) {
croak("fields is not an array ref");
} else {
av = (AV*) SvRV(fields);
}
ST(0) = xsEncode(hv, av, dst, useIO, eol) ? &PL_sv_yes : &PL_sv_undef;
XSRETURN(1);
}
SV*
Decode(self, src, fields, useIO)
SV* self
SV* src
SV* fields
bool useIO
PROTOTYPE: $$$$
PPCODE:
{
HV* hv;
AV* av;
int result;
CSV_XS_SELF;
if (!fields || !SvOK(fields) || !SvROK(fields)
|| SvTYPE(SvRV(fields)) != SVt_PVAV) {
croak("fields is not an array ref");
} else {
av = (AV*) SvRV(fields);
}
ST(0) = xsDecode(hv, av, src, useIO) ? &PL_sv_yes : &PL_sv_no;
XSRETURN(1);
}
void
print(self, io, fields)
SV* self
SV* io
SV* fields
PROTOTYPE: $$$
PPCODE:
{
HV* hv;
AV* av;
SV* eol;
SV** svp;
CSV_XS_SELF;
if (!fields || !SvOK(fields) || !SvROK(fields) ||
SvTYPE(SvRV(fields)) != SVt_PVAV) {
croak("Expected fields to be an array ref");
}
av = (AV*) SvRV(fields);
if ((svp = hv_fetch(hv, "eol", 3, FALSE))) {
eol = *svp;
} else {
eol = &PL_sv_undef;
}
ST(0) = xsEncode(hv, av, io, 1, eol) ? &PL_sv_yes : &PL_sv_no;
XSRETURN(1);
}
void
getline(self, io)
SV* self
SV* io
PROTOTYPE: $;$
PPCODE:
{
HV* hv;
AV* av;
SV* rv;
CSV_XS_SELF;
hv_delete(hv, "_ERROR_INPUT", 12, G_DISCARD);
av = newAV();
ST(0) = xsDecode(hv, av, io, 1) ?
sv_2mortal(newRV_noinc((SV*) av)) : &PL_sv_undef;
XSRETURN(1);
}
Text-CSV_XS-0.23-alt2/ChangeLog 0000644 0000000 0000000 00000004702 10611542315 0016036 0 ustar 00root root 0000000 0000000 2001-10-10 Jochen Wiedmann <joe@ispsoft.de> (0.23)
* Changed "char" to "unsigned char" in CSV_XS.xs.
Matthew Graham <MGraham@pacificaccess.com.au>
2000-12-22 Jochen Wiedmann <joe@ispsoft.de> (0.22)
* CSV_XS.xs: Added the handling of escape characters
outside of quotes. Kirill Paliy <kpaliy@aaanet.ru>
2000-08-18 Jochen Wiedmann <joe@ispsoft.de> (0.21)
* CSV_XS.pm (parse): Minor bugfix in the parse method.
Norikatsu Shigemura (nork@cityfujisawa.ne.jp)
1999-06-28 Jochen Wiedmann <joe@ispsoft.de> (0.20)
* CSV_XS.xs: Fixed a bug in the decoder where escapeChar wasn't
handled right. Pavel Kotala <pkotala@logis.cz>
1999-05-01 Jochen Wiedmann <joe@ispsoft.de> (0.19)
* CSV_XS.xs: Setting escape_char => undef should now work.
Requested by Syed Muhammad Nayeem <smnayeem@dhaka.agni.com>
1999-04-05 Jochen Wiedmann <joe@ispsoft.de> (0.18)
* CSV_XS.pm: Portability fixes (sv_undef => PL_sv_undef
and the like.
1999-03-04 Jochen Wiedmann <joe@ispsoft.de> (0.17)
* CSV_XS.pm: Added always_quote attribute.
(Ken Williams <kwilliam@DigitalRiver.com>)
* The types method is now implemented in Perl.
1999-02-11 Jochen Wiedmann <joe@ispsoft.de> (0.16)
* CSV_XS.pm: PV, IV and NV are no longer exportable, so that I
need not inherit from Exporter any longer. (This caused trying
to autoload DESTROY without any reason. Seems to me to be a
serious performance penalty.)
* CSV_XS.pm: Being a little bit less strict now: If quoteChar and
escapeChar are different, then the quote char may be part of
the field. (Not at the fields start, of course.)
1998-08-21 Jochen Wiedmann <joe@ispsoft.de> (0.15)
* CSV_XS.pm: Moved print() and getline() to XS.
1998-08-13 Jochen Wiedmann <joe@ispsoft.de> (0.14)
* CSV_XS.xs: Forgot to escape sepchar; patched by Paul Walmsley,
<shag@nicar.org>.
1998-07-20 Jochen Wiedmann <joe@ispsoft.de> (0.13)
* CSV_XS.xs (Encode): Strings qre quoted only if required.
* CSV_XS.xs: Added support for $csv->{types}.
1998-06-11 Jochen Wiedmann <joe@ispsoft.de> (0.12)
* CSV_XS.xs (Encode): Integers and Reals are no longer quoted.
* Added $csv->{types}.
1998-05-12 Jochen Wiedmann <joe@ispsoft.de> (0.11)
* Added $csv->{eol}
* Added $csv->{quote_char} = undef
1998-05-05 Jochen Wiedmann <joe@ispsoft.de> (0.10)
* Moved encoding and decoding to XS; added binary mode; added
print() and getline() methods.
1998-06-05 Alan Citterman <alan@mfgrtl.com>
* Initial version
Text-CSV_XS-0.23-alt2/MANIFEST 0000644 0000000 0000000 00000000644 10611542315 0015416 0 ustar 00root root 0000000 0000000 ChangeLog Change history
README Docs
MANIFEST This file
CSV_XS.pm Perl part of the module
CSV_XS.xs C part of the module
Makefile.PL Makefile generator
ppport.h
test.pl Small benchmark script
t/base.t Base tests (combine and parse only)
t/file.t IO tests (print and getline)
t/misc.t Binary mode tests
t/types.t Tests for the "types" attribute.
t/samples.t Miscellaneous problems from the modules history.
Text-CSV_XS-0.23-alt2/Makefile.PL 0000644 0000000 0000000 00000001613 10611542315 0016234 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
require ExtUtils::MakeMaker;
=pod
my($def) = '';
if ($ENV{'USER'} eq 'joe' && $ENV{'HOSTNAME'} eq 'laptop.ispsoft.de') {
$def .= ' -Wall -Wno-unused';
}
eval { require Text::CSV_XS };
if (!$@ && $Text::CSV_XS::VERSION < 0.15) {
print <<'MSG';
You seem to have installed a previous version of the Text::CSV_XS module.
Note that you might encounter problems in existing applications (not the
DBD::CSV driver) due to incompatible changes in the print and getline
methods. See "perldoc CSV_XS.pm" for details.
MSG
sleep 5;
}
=cut
ExtUtils::MakeMaker::WriteMakefile(
'NAME' => 'Text::CSV_XS',
'VERSION_FROM' => 'CSV_XS.pm', # finds $VERSION
'dist' => { 'SUFFIX' => ".gz",
'DIST_DEFAULT' => 'all tardist',
'COMPRESS' => "gzip -9f" },
# 'DEFINE' => $def
);
Text-CSV_XS-0.23-alt2/README 0000644 0000000 0000000 00000001416 10611542315 0015143 0 ustar 00root root 0000000 0000000 Module: Text::CSV
Description:
Text::CSV provides facilities for the composition and decomposition of
comma-separated values. An instance of the Text::CSV class can combine
fields into a CSV string and parse a CSV string into fields.
Copying:
Copyright (c) 1998 Jochen Wiedmann. All rights reserved.
Portions Copyright (c) 1997 Alan Citterman. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Prerequisites:
perl 5.002
Build/Installation:
Standard build/installation supported by ExtUtils::MakeMaker(3)...
perl Makefile.PL
make
make test
make install
Author:
Jochen Wiedmann <joe@ispsoft.de>
Interface design by Alan Citterman <alan@mfgrtl.com>
Text-CSV_XS-0.23-alt2/perl-Text-CSV_XS.spec 0000644 0000000 0000000 00000002130 10611542315 0020060 0 ustar 00root root 0000000 0000000 %define dist Text-CSV_XS
Name: perl-%dist
Version: 0.23
Release: alt2
Summary: Comma-separated values manipulation routines
License: GPL or Artistic
Group: Development/Perl
URL: %CPAN %dist
Source: %dist-%version-%release.tar
# Automatically added by buildreq on Thu Apr 19 2007
BuildRequires: perl-devel
%description
Text::CSV_XS provides facilities for the composition and decomposition of
comma-separated values. An instance of the Text::CSV_XS class can combine
fields into a CSV string and parse a CSV string into fields.
%prep
%setup -q -n %dist-%version-%release
%build
%perl_vendor_build
%install
%perl_vendor_install
%files
%doc ChangeLog README
%perl_vendor_archlib/Text*
%perl_vendor_autolib/Text*
%changelog
* Thu Apr 19 2007 Alexey Tourbin <at@altlinux.ru> 0.23-alt2
- cleanup
* Sat Feb 19 2005 ALT QA Team Robot <qa-robot@altlinux.org> 0.23-alt1.1
- Rebuilt with rpm-build-perl-0.5.1.
* Tue Jul 08 2003 Michael Shigorin <mike@altlinux.ru> 0.23-alt1
- alt1
- spec file provided by Valentin Solomko
* Thu May 15 2003 Valentyn Solomko <vesna@slovnyk.org> 0.23-val1
- built for ALT Linux
Text-CSV_XS-0.23-alt2/ppport.h 0000644 0000000 0000000 00000017163 10611542315 0015766 0 ustar 00root root 0000000 0000000
#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_
/* Perl/Pollution/Portability Version 1.0007 */
/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
distributed under the same license as any version of Perl. */
/* For the latest version of this code, please retreive the Devel::PPPort
module from CPAN, contact the author at <kjahds@kjahds.com>, or check
with the Perl maintainers. */
/* If you needed to customize this file for your project, please mention
your changes, and visible alter the version number. */
/*
In order for a Perl extension module to be as portable as possible
across differing versions of Perl itself, certain steps need to be taken.
Including this header is the first major one, then using dTHR is all the
appropriate places and using a PL_ prefix to refer to global Perl
variables is the second.
*/
/* If you use one of a few functions that were not present in earlier
versions of Perl, please add a define before the inclusion of ppport.h
for a static include, or use the GLOBAL request in a single module to
produce a global definition that can be referenced from the other
modules.
Function: Static define: Extern define:
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
*/
/* To verify whether ppport.h is needed for your module, and whether any
special defines should be used, ppport.h can be run through Perl to check
your source code. Simply say:
perl -x ppport.h *.c *.h *.xs foo/*.c [etc]
The result will be a list of patches suggesting changes that should at
least be acceptable, if not necessarily the most efficient solution, or a
fix for all possible problems. It won't catch where dTHR is needed, and
doesn't attempt to account for global macro or function definitions,
nested includes, typemaps, etc.
In order to test for the need of dTHR, please try your module under a
recent version of Perl that has threading compiled-in.
*/
/*
#!/usr/bin/perl
@ARGV = ("*.xs") if !@ARGV;
%badmacros = %funcs = %macros = (); $replace = 0;
foreach (<DATA>) {
$funcs{$1} = 1 if /Provide:\s+(\S+)/;
$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
$replace = $1 if /Replace:\s+(\d+)/;
$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
}
foreach $filename (map(glob($_),@ARGV)) {
unless (open(IN, "<$filename")) {
warn "Unable to read from $file: $!\n";
next;
}
print "Scanning $filename...\n";
$c = ""; while (<IN>) { $c .= $_; } close(IN);
$need_include = 0; %add_func = (); $changes = 0;
$has_include = ($c =~ /#.*include.*ppport/m);
foreach $func (keys %funcs) {
if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
if ($c !~ /\b$func\b/m) {
print "If $func isn't needed, you don't need to request it.\n" if
$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
} else {
print "Uses $func\n";
$need_include = 1;
}
} else {
if ($c =~ /\b$func\b/m) {
$add_func{$func} =1 ;
print "Uses $func\n";
$need_include = 1;
}
}
}
if (not $need_include) {
foreach $macro (keys %macros) {
if ($c =~ /\b$macro\b/m) {
print "Uses $macro\n";
$need_include = 1;
}
}
}
foreach $badmacro (keys %badmacros) {
if ($c =~ /\b$badmacro\b/m) {
$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
$need_include = 1;
}
}
if (scalar(keys %add_func) or $need_include != $has_include) {
if (!$has_include) {
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
"#include \"ppport.h\"\n";
$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
} elsif (keys %add_func) {
$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
}
if (!$need_include) {
print "Doesn't seem to need ppport.h.\n";
$c =~ s/^.*#.*include.*ppport.*\n//m;
}
$changes++;
}
if ($changes) {
open(OUT,">/tmp/ppport.h.$$");
print OUT $c;
close(OUT);
open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
close(DIFF);
unlink("/tmp/ppport.h.$$");
} else {
print "Looks OK\n";
}
}
__DATA__
*/
#ifndef PERL_REVISION
# ifndef __PATCHLEVEL_H_INCLUDED__
# include "patchlevel.h"
# endif
# ifndef PERL_REVISION
# define PERL_REVISION (5)
/* Replace: 1 */
# define PERL_VERSION PATCHLEVEL
# define PERL_SUBVERSION SUBVERSION
/* Replace PERL_PATCHLEVEL with PERL_VERSION */
/* Replace: 0 */
# endif
#endif
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
#ifndef ERRSV
# define ERRSV perl_get_sv("@",FALSE)
#endif
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
# define PL_sv_no sv_no
# define PL_na na
# define PL_stdingv stdingv
# define PL_hints hints
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_copline copline
# define PL_Sv Sv
/* Replace: 0 */
#endif
#ifndef dTHR
# ifdef WIN32
# define dTHR extern int Perl___notused
# else
# define dTHR extern int errno
# endif
#endif
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif
#ifndef newSVpvn
# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
#endif
#ifndef newRV_inc
/* Replace: 1 */
# define newRV_inc(sv) newRV(sv)
/* Replace: 0 */
#endif
#ifndef newRV_noinc
# ifdef __GNUC__
# define newRV_noinc(sv) \
({ \
SV *nsv = (SV*)newRV(sv); \
SvREFCNT_dec(sv); \
nsv; \
})
# else
# if defined(CRIPPLED_CC) || defined(USE_THREADS)
static SV * newRV_noinc (SV * sv)
{
SV *nsv = (SV*)newRV(sv);
SvREFCNT_dec(sv);
return nsv;
}
# else
# define newRV_noinc(sv) \
((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
# endif
# endif
#endif
/* Provide: newCONSTSUB */
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
#if defined(NEED_newCONSTSUB)
static
#else
extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
#endif
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
newCONSTSUB(stash,name,sv)
HV *stash;
char *name;
SV *sv;
{
U32 oldhints = PL_hints;
HV *old_cop_stash = PL_curcop->cop_stash;
HV *old_curstash = PL_curstash;
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
/* before 5.003_22 */
start_subparse(),
#else
# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
/* 5.003_22 */
start_subparse(0),
# else
/* 5.003_23 onwards */
start_subparse(FALSE, 0),
# endif
#endif
newSVOP(OP_CONST, 0, newSVpv(name,0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
}
#endif
#endif /* newCONSTSUB */
#endif /* _P_P_PORTABILITY_H_ */
Text-CSV_XS-0.23-alt2/t/ 0000755 0000000 0000000 00000000000 10611542315 0014524 5 ustar 00root root 0000000 0000000 Text-CSV_XS-0.23-alt2/t/base.t 0000644 0000000 0000000 00000010044 10611542315 0015622 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
use vars qw($loaded);
BEGIN { $| = 1; print "1..28\n"; }
END {print "not ok 1\n" unless $loaded;}
use Text::CSV_XS;
$loaded = 1;
print "ok 1\n";
my($testNum) = 1;
sub Test($) {
my($result) = shift;
$testNum++;
print(($result ? "" : "not "), "ok $testNum\n");
$result;
}
#
# empty subclass test
#
package Empty_Subclass;
@Empty_Subclass::ISA = qw(Text::CSV_XS);
package main;
#
# Important: Do not modify these tests unless you have a good
# reason. This file ought to guarantee compatibility to Text::CSV.
#
my($empty) = Empty_Subclass->new();
Test(ref($empty) eq 'Empty_Subclass')
or printf("Expected subclass %s, got %s\n",
'Empty_Subclass', ref($empty));
Test($empty->version() == Text::CSV_XS->version())
or printf("Expected version %s, got %s\n",
&Text::CSV_XS->version(), $empty->version());
Test($empty->parse(''))
or print("Subclass parse() failed.\n");
Test($empty->combine(''))
or printf("Subclass combine() failed.\n");
my $csv = Text::CSV_XS->new();
#
# Important: Do not modify these tests unless you have a good
# reason. This file ought to guarantee compatibility to Text::CSV.
#
Test(!$csv->combine()) # fail - missing argument
or print "Missing argument, but no failure\n";
Test(!$csv->combine('abc', "def\n", 'ghi')) # fail - bad character
or print "Bad character, but no failure\n";
Test($csv->combine('') && ($csv->string eq q())) # succeed
or printf("Expected %s, got %s\n", q(), $csv->string());
Test($csv->combine('', ' ') && ($csv->string eq q(," "))) # succeed
or printf("Expected %s, got %s\n", q("",""), $csv->string());
Test($csv->combine('', 'I said, "Hi!"', '') &&
($csv->string eq q(,"I said, ""Hi!""",))) # succeed
or printf("Expected %s, got %s\n", q("","I said, ""Hi!""",""),
$csv->string());
Test($csv->combine('"', 'abc') && ($csv->string eq q("""",abc))) # succeed
or printf("Expected %s, got %s\n", q("""","abc"), $csv->string());
Test($csv->combine(',') && ($csv->string eq q(","))) # succeed
or printf("Expected %s, got %s\n", q("""","abc"), $csv->string());
Test($csv->combine('abc', '"') && ($csv->string eq q(abc,""""))) # succeed
or printf("Expected %s, got %s\n", q("abc",""""), $csv->string());
Test($csv->combine('abc', 'def', 'ghi', 'j,k') &&
($csv->string eq q(abc,def,ghi,"j,k"))) # succeed
or printf("Expected %s, got %s\n", q(abc,def,ghi,"j,k"),
$csv->string());
Test($csv->combine("abc\tdef", 'ghi') &&
($csv->string eq qq("abc\tdef",ghi))) # succeed
or printf("Expected %s, got %s\n", qq("abc\tdef","ghi"),
$csv->string());
Test(!$csv->parse())
or print "Missing argument, but no failure\n";
Test(!$csv->parse('"abc'))
or print("Missing closing double-quote, but no failure\n");
Test(!$csv->parse('ab"c'))
or print("Double quote outside of double-quotes, but no failure.\n");
Test(!$csv->parse('"ab"c"'))
or print("Bad character sequence, but no failure.\n");
Test(!$csv->parse(qq("abc\nc")))
or print("Bad character, but no failure.\n");
Test(!$csv->status())
or print("Wrong status\n");
Test($csv->parse(q(",")) and ($csv->fields())[0] eq ',') # success
or printf("Expected field 0 to be ',', got %s\n", ($csv->fields())[0]);
Test($csv->parse(qq("","I said,\t""Hi!""","")));
Test(($csv->fields())[0] eq '')
or printf("Expected field 0 to be '', got %s\n",
($csv->fields())[0]);
Test(($csv->fields())[1] eq qq(I said,\t"Hi!"))
or printf("Expected field 1 to be '%s', got %s\n",
qq(I said,\t"Hi!"), ($csv->fields())[1]);
Test(($csv->fields())[2] eq '')
or printf("Expected field 2 to be '', got %s\n",
($csv->fields())[2]);
Test($csv->status())
or print("Wrong status\n");
# Are Integers and Reals quoted?
#
# Important: Do not modify these tests unless you have a good
# reason. This file ought to guarantee compatibility to Text::CSV.
#
Test($csv->combine('', 2, 3.4, 'a', 'a b')
&& ($csv->string eq q(,2,3.4,a,"a b"))) # succeed
or printf("Expected %s, got %s\n", q(""), $csv->string());
Text-CSV_XS-0.23-alt2/t/file.t 0000644 0000000 0000000 00000010776 10611542315 0015643 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
use vars qw($loaded);
$| = 1;
print "1..72\n";
require Text::CSV_XS;
############################################################################
package IO_Scalar; # IO::Scalar replacement, because IO::Scalar is not
# yet a Core module.
sub new ($;\$) {
my($proto, $strRef) = @_;
my($self);
if (!$strRef) {
my($str) = "";
$self = \$str;
} elsif (ref($strRef) ne 'SCALAR') {
die "Expected scalar ref";
} else {
$self = \$$strRef;
}
bless($self, (ref($proto) || $proto));
$self;
}
sub print ($@) {
my($self) = shift;
while (@_ > 0) {
my($str) = shift;
if (defined($str)) {
$$self .= $str;
}
}
1;
}
sub getline ($) {
my($self) = shift;
my($result);
my($ifs) = $/;
if (length($$self) == 0) {
$result = undef;
} elsif (defined($ifs) && $$self =~ /^(.*?$ifs)(.*)$/s) {
$result = $1;
$$self = $2;
} else {
$result = $$self;
$$self = '';
}
$result;
}
sub sref ($) {
shift;
}
sub Contents ($) {
${shift()->sref};
}
sub flush ($) {
1;
}
############################################################################
my($testNum) = 0;
sub Test($) {
my($result) = shift;
$testNum++;
print(($result ? "" : "not "), "ok $testNum\n");
$result;
}
sub TestContents ($$@) {
my ($csv, $fh, @input) = @_;
Test($csv->combine(@input)) or print "Failed to parse input";
my($got) = $fh->Contents();
Test($csv->string() eq $got)
or printf("Expected %s, got %s\n", $csv->string(), $got);
}
sub TestPrintRead ($$@) {
my($csv, @input) = @_;
my($fh) = IO_Scalar->new();
Test($csv->print($fh, \@input));
TestContents($csv, $fh, @input);
Test($csv->getline($fh))
or print("Failed to read.\n");
Test($csv->fields() == @input)
or print("Expected %d fields, got %d\n",
scalar($csv->fields()), scalar(@input));
my($i);
for ($i = 0; $i < @input; $i++) {
Test(($csv->fields())[$i] eq $input[$i])
or printf("Expected field $i to be '%s', got '%s'\n",
$input[$i], ($csv->fields())[$i]);
}
}
sub TestReadFailure ($$) {
my($csv, $input) = @_;
my($fh) = IO_Scalar->new();
if (!$fh->print($input) || !$fh->flush()) {
die "Error while creating input file: $!";
}
Test(!$csv->getline($fh));
}
sub TestRead ($$@) {
my($csv, $input, @expected) = @_;
my($fh) = IO_Scalar->new();
if (!$fh->print($input) || !$fh->flush()) {
die "Error while creating input file: $!";
}
my $fields = $csv->getline($fh);
Test($fields) or print("Failed to read\n");
Test(@expected == @$fields)
or printf("Expected %d fields, got %d\n",
scalar(@expected), scalar($csv->fields()));
my($i);
for ($i = 0; $i < @expected; $i++) {
if ($expected[$i] ne $$fields[$i]) {
printf("Field $i: Expected %s, got %s\n",
$expected[$i], $$fields[$i]);
}
}
}
my($csv) = Text::CSV_XS->new();
my($fh) = IO_Scalar->new();
Test(!$csv->print($fh, ["abc", "def\007", "ghi"]))
or print "Bad character, but no failure\n";
TestPrintRead($csv, q(""));
TestPrintRead($csv, '', '');
TestPrintRead($csv, '', 'I said, "Hi!"', '');
TestPrintRead($csv, '"', 'abc');
TestPrintRead($csv, 'abc', '"');
TestPrintRead($csv, 'abc', 'def', 'ghi');
TestPrintRead($csv, "abc\tdef", 'ghi');
TestReadFailure($csv, '"abc')
or print("Missing closing double-quote, but no failure\n");
TestReadFailure($csv, 'ab"c')
or print("Double quote outside of double-quotes, but no failure.\n");
TestReadFailure($csv, '"ab"c"')
or print("Bad character sequence, but no failure.\n");
TestReadFailure($csv, qq("abc\nc"))
or print("Bad character, but no failure.\n");
TestRead($csv, q(","), ',');
TestRead($csv, qq("","I said,\t""Hi!""",""),
'', qq(I said,\t"Hi!"), '');
# This test because of a problem with DBD::CSV
$fh = IO_Scalar->new();
$csv->{binary} = 1;
$csv->{eol} = "\015\012";
Test($csv->print($fh, ["id","name"]))
or print "Bad character, but no failure\n";
Test($csv->print($fh, [1, "Alligator Descartes"]));
Test($csv->print($fh, ["3", "Jochen Wiedmann"]));
Test($csv->print($fh, [2, "Tim Bunce"]));
Test($csv->print($fh, [" 4", "Andreas KЖnig"]));
Test($csv->print($fh, [5]));
my $contents;
Test(($contents = $fh->Contents()) eq <<"CONTENTS");
id,name\015
1,"Alligator Descartes"\015
3,"Jochen Wiedmann"\015
2,"Tim Bunce"\015
" 4","Andreas KЖnig"\015
5\015
CONTENTS
my $fields;
print "Retrieving data\n";
for (my $i = 0; $i < 6; $i++) {
Test($fields = $csv->getline($fh))
and print "Row $i: $fields (@$fields)\n";
}
Text-CSV_XS-0.23-alt2/t/misc.t 0000644 0000000 0000000 00000004357 10611542315 0015655 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
require Text::CSV_XS;
my($testNum) = 0;
sub Test($) {
my($result) = shift;
$testNum++;
print(($result ? "" : "not "), "ok $testNum\n");
$result;
}
$| = 1;
print "1..15\n";
my(@binFields) = ("abc\0def\n\rghi", "ab\"ce,\032\"'", "\377");
my($csv) = Text::CSV_XS->new({'binary' => 1});
Test($csv->combine(@binFields)) or print "Failed to encode binary fields\n";
my($string) = $csv->string();
Test($string eq qq("abc"0def\n\rghi","ab""ce,\032""'",\377))
or printf("Encode: Expected \n%s\n, got \n%s\n",
unpack("H*", qq("abc"0def\n\rghi","ab""ce,\032""'")),
unpack("H*", $string));
Test($csv->parse($string)) or print "Failed to decode binary fields\n";
Test($csv->fields() == @binFields) or print "Wrong number of fields.\n";
Test(($csv->fields())[0] eq $binFields[0])
or printf("Field 0: Expected %s, got %s.\n",
$binFields[0], ($csv->fields())[0]);
Test(($csv->fields())[1] eq $binFields[1])
or printf("Field 1: Expected %s, got %s.\n",
$binFields[1], ($csv->fields())[1]);
Test(($csv->fields())[2] eq $binFields[2])
or printf("Field 1: Expected %s, got %s.\n",
$binFields[1], ($csv->fields())[1]);
$csv->{'eol'} = "\r\n";
Test($csv->combine(@binFields)) or print "Failed to encode binary fields\n";
$string = $csv->string();
Test($string eq qq("abc"0def\n\rghi","ab""ce,\032""'",\377\r\n))
or printf("Encode: Expected \n%s\n, got \n%s\n",
unpack("H*", qq("abc"0def\n\rghi","ab""ce,\032""'")),
unpack("H*", $string));
$csv->{'eol'} = "\n";
Test($csv->combine(@binFields)) or print "Failed to encode binary fields\n";
$string = $csv->string();
Test($string eq qq("abc"0def\n\rghi","ab""ce,\032""'",\377\n))
or printf("Encode: Expected \n%s\n, got \n%s\n",
unpack("H*", qq("abc"0def\n\rghi","ab""ce,\032""'")),
unpack("H*", $string));
$csv->{'quote_char'} = undef;
Test($csv->combine("abc","def","ghi"));
Test($csv->string() eq qq(abc,def,ghi\n));
# Ken's test
{
my $csv2 = Text::CSV_XS->new({'always_quote' => 1});
Test($csv2->combine("abc","def","ghi"));
Test($csv2->string() eq qq("abc","def","ghi"))
or printf("Expected %s, got %s.\n", qq("abc","def","ghi"),
$csv2->string());
}
Text-CSV_XS-0.23-alt2/t/samples.t 0000644 0000000 0000000 00000001362 10611542315 0016357 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
use Text::CSV_XS ();
#
# Some assorted examples from the modules history
#
{
my $testNum = 0;
sub Test($) {
my($result) = shift;
$testNum++;
print(($result ? "" : "not "), "ok $testNum\n");
$result;
}
}
$| = 1;
print "1..7\n";
#
# "Pavel Kotala" <pkotala@logis.cz>
#
{
my $csv = Text::CSV_XS->new({'quote_char' => '"',
'escape_char' => '\\',
'sep_char' => ';',
'binary' => 1});
Test($csv);
my @list = ("c:\\winnt", "text");
Test($csv->combine(@list));
my $line = $csv->string();
Test($line);
Test($csv->parse($line));
my @olist = $csv->fields();
Test(@list == @olist);
Test($list[0] eq $olist[0]);
Test($list[1] eq $olist[1]);
}
Text-CSV_XS-0.23-alt2/t/types.t 0000644 0000000 0000000 00000001761 10611542315 0016062 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
use Text::CSV_XS ();
{
my $testNum = 0;
sub Test($) {
my($result) = shift;
$testNum++;
print(($result ? "" : "not "), "ok $testNum\n");
$result;
}
}
$| = 1;
$^W = 1;
print "1..12\n";
my $csv = Text::CSV_XS->new({'types' => [Text::CSV_XS::IV(),
Text::CSV_XS::PV(),
Text::CSV_XS::NV()]});
Test($csv);
Test(@{$csv->{'types'}} == 3);
Test($csv->{'types'}->[0] == Text::CSV_XS::IV() and
$csv->{'types'}->[1] == Text::CSV_XS::PV() and
$csv->{'types'}->[2] == Text::CSV_XS::NV());
Test(length($csv->{'_types'}) == 3);
Test($csv->{'_types'} eq
chr(Text::CSV_XS::IV()) . chr(Text::CSV_XS::PV()) .
chr(Text::CSV_XS::NV()));
Test($csv->combine('', '', '1.00'));
Test($csv->string() eq ",,1.00");
my $warning;
$SIG{__WARN__} = sub { $warning = shift };
Test($csv->parse($csv->string()));
Test($warning =~ /numeric/);
my @fields = $csv->fields();
Test($fields[0] eq '0');
Test($fields[1] eq '');
Test($fields[2] eq '1');
Text-CSV_XS-0.23-alt2/test.pl 0000644 0000000 0000000 00000001623 10611542315 0015577 0 ustar 00root root 0000000 0000000 # -*- perl -*-
require 5.004;
use strict;
require Text::CSV_XS;
require Benchmark;
my(@fields) = ("Wiedmann", "Jochen", "Am Eisteich 9", "72555 Metzingen",
"Germany", "+49 7123 14881", "joe\@ispsoft,de");
my($csv) = Text::CSV_XS->new();
my($count) = 10000;
print "Testing row creation speed ...\n";
my($t1) = Benchmark->new();
for (my($i) = 0; $i < $count; $i++) {
$csv->combine(@fields);
}
my($td) = Benchmark::timediff(Benchmark->new(), $t1);
my($dur) = $td->cpu_a;
printf("$count rows created in %.1f cpu+sys seconds (%d per sec)\n\n",
$dur, $count / $dur);
print "Testing row parsing speed ...\n";
my($str) = $csv->string();
$t1 = Benchmark->new();
for (my($i) = 0; $i < $count; $i++) {
$csv->parse($str);
}
$td = Benchmark::timediff(Benchmark->new(), $t1);
$dur = $td->cpu_a;
printf("$count rows parsed in %.1f cpu+sys seconds (%d per sec)\n\n",
$dur, $count / $dur);