Class-CSV-1.03/0040755000206400017500000000000010562510014012267 5ustar davidrutibaClass-CSV-1.03/MANIFEST0100644000206400017500000000020010212737757013426 0ustar davidrutibaChanges CSV.pm Makefile.PL MANIFEST README t/1.t META.yml Module meta-data (added by MakeMaker) Class-CSV-1.03/t/0040755000206400017500000000000010562510014012532 5ustar davidrutibaClass-CSV-1.03/t/1.t0100644000206400017500000000076210212737527013075 0ustar davidrutiba# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test; BEGIN { plan tests => 1 }; use Class::CSV; ok(1); # If we made it this far, we're ok. ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. Class-CSV-1.03/CSV.pm0100644000206400017500000003717610562477752013320 0ustar davidrutiba# Class::CSV # Class Based CSV Parser/Writer # Written by DJ # # $Id: CSV.pm,v 1.2 2005/03/07 02:43:48 david Exp $ # Class::CSV::Base package Class::CSV::Base; use strict; use warnings; BEGIN { ## Modules # Core use Carp qw/confess/; # Base use base qw(Class::Accessor); ## Constants use constant TRUE => 1; use constant FALSE => 0; ## Variables use vars qw($VERSION); $VERSION = do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r}; } sub _build_fields { my ($self, $fields) = @_; confess "Field list must be an array reference\n" unless (defined $fields and ref $fields eq 'ARRAY'); $self->{_field_list} = $fields; # make the accessors via Class::Accessor __PACKAGE__->mk_accessors(@{$fields}); foreach my $field (@{$fields}) { $self->{__fields}->{$field} = TRUE; } } sub set { my ($self, %items) = @_; foreach my $field (keys %items) { if (exists $self->{__fields}->{$field}) { $self->_set($field, $items{$field}); } else { confess "Cannot set field: ". $field. " as it doesnt exist!\n"; } } } sub _set { my ($self, $key, $value) = @_; return $self->{$key} = $value; } sub get { my ($self, @fields) = @_; # sanity check foreach my $field (@fields) { unless (exists $self->{__fields}->{$field}) { confess "Cannot get field: ". $field. " as it doesnt exist!\n"; } } return $self->_get(@fields); } sub _get { my $self = shift; if(@_ == 1) { return $self->{$_[0]}; } elsif( @_ > 1 ) { return @{$self}{@_}; } return; } 1; # Class::CSV::CSV_XS_Options package Class::CSV::CSV_XS_Options; BEGIN { ## Modules # Core use Carp qw/confess/; ## Constants use constant TRUE => 1; use constant FALSE => 0; # Base use base qw(Class::CSV::Base); } sub new { my ($class, $opts) = @_; my $self = bless({}, $class); $self->_build_fields([qw/quote_char eol escape_char sep_char binary types always_quote/]); if (defined $opts) { if (ref $opts eq 'HASH') { $self->set(%{$opts}); } else { confess "Please provide csv_xs_options as a HASH ref!\n"; } } return $self; } sub set { my ($self, %items) = @_; foreach my $field (keys %items) { unless (exists $self->{__fields}->{$field}) { $self->{__fields}->{$field} = TRUE; $self->mk_accessors($field); } $self->_set($field => $items{$field}); } } sub to_hash_ref { my ($self) = @_; my $hash = {}; foreach my $field (keys %{$self->{__fields}}) { my $value = $self->get($field); if (defined $value) { $hash->{$field} = $value; } } return $hash; } # Class::CSV::Line package Class::CSV::Line; BEGIN { ## Modules # Core use Carp qw/confess/; # CPAN use Text::CSV_XS; ## Constants use constant TRUE => 1; use constant FALSE => 0; # Base use base qw(Class::CSV::Base); } sub new { my ($class, %opts) = @_; confess "Please provide a list of fields\n" unless (exists $opts{fields}); my $self = bless({}, $class); $self->{__csv_xs_options} = $opts{csv_xs_options}; $self->_build_fields($opts{fields}); $self->_do_parse($opts{line}) if (exists $opts{line}); return $self; } sub parse { my ($class, %opts) = @_; confess "Please provide a line to parse\n" unless (exists $opts{line}); my $self = $class->new(%opts); $self->_do_parse($opts{line}); return $self; } sub _build_fields { my ($self, $fields) = @_; confess "Field list must be an array reference\n" unless (defined $fields and ref $fields eq 'ARRAY'); $self->{_field_list} = $fields; # make the accessors via Class::Accessor __PACKAGE__->mk_accessors(@{$fields}); foreach my $field (@{$fields}) { $self->{__fields}->{$field} = TRUE; $self->_set($field, undef); } } sub _do_parse { my ($self, $line) = @_; confess "Unable to find field array ref to build object with\n" unless (defined $self->{_field_list} and ref $self->{_field_list} eq 'ARRAY'); my $csv = new Text::CSV_XS($self->{__csv_xs_options}->to_hash_ref()); my $r = $csv->parse($line); if (defined $r and $r) { my @columns = $csv->fields(); for (my $i = 0; $i < @columns; $i++) { $self->set(${$self->{_field_list}}[$i], $columns[$i]); } } else { if ($csv->error_input()) { confess "Failed to parse line: ". $csv->error_input(). "\n"; } else { confess "Failed to parse line: unknown reason\n"; } } } sub string { my ($self) = @_; confess "Uninitiated Line Objects cannot be converted to a string!\n" unless (exists $self->{_field_list} and ref $self->{_field_list} eq 'ARRAY'); my @cols = (); foreach my $field (@{$self->{_field_list}}) { push(@cols, $self->_get($field)); } my $csv = new Text::CSV_XS($self->{__csv_xs_options}->to_hash_ref()); my $r = $csv->combine(@cols); if ($r) { return $csv->string(); } else { confess "Failed to create CSV line from line: ". $csv->error_input(). "\n" } } 1; # Class::CSV package Class::CSV; BEGIN { ## Modules # Core use Carp qw/confess/; # Base use base qw(Class::CSV::Base); ## Constants use constant TRUE => 1; use constant FALSE => 0; use constant DEFAULT_LINE_SEPARATOR => "\n"; ## Setup Accessors __PACKAGE__->mk_ro_accessors(qw(fields)); __PACKAGE__->mk_accessors(qw(lines line_separator csv_xs_options)); } sub new { my ($class, %opts) = @_; my $self = bless({}, $class); confess "Please provide an array ref of fields\n" unless (exists $opts{fields} and ref $opts{fields} eq 'ARRAY'); $self->_private_set( line_separator => $opts{line_separator} || DEFAULT_LINE_SEPARATOR, csv_xs_options => new Class::CSV::CSV_XS_Options($opts{csv_xs_options}), fields => $opts{fields}, lines => [] ); return $self; } sub parse { my ($class, %opts) = @_; my $self = $class->new(%opts); if (exists $opts{classdbi_objects}) { $opts{objects} = $opts{classdbi_objects}; delete($opts{classdbi_objects}); } if (exists $opts{filename} or exists $opts{filehandle}) { $self->_do_parse(%opts); } elsif (exists $opts{objects}) { $self->_do_parse_objects(%opts); } else { confess "Please provide objects or a filename/filehandle to parse\n"; } return $self; } sub _do_parse { my ($self, %opts) = @_; my @CSV_Content = (); if (exists $opts{'filename'} and defined $opts{'filename'}) { confess "Cannot find filename: ". $opts{'filename'}. "\n" unless (-f $opts{'filename'}); confess "Cannot read filename: ". $opts{'filename'}. "\n" unless (-r $opts{'filename'}); open(CSV, $opts{'filename'}) or confess "Failed to open filename: ". $opts{'filename'}. ': '. $!. "\n"; while (my $line = ) { push(@CSV_Content, $self->strip_crlf($line)); } close(CSV); } elsif (exists $opts{'filehandle'} and defined $opts{'filehandle'}) { confess "filehandle provided is not a file handle\n" unless (defined(fileno($opts{'filehandle'}))); my $fh = $opts{'filehandle'}; while (my $line = <$fh>) { push(@CSV_Content, $self->strip_crlf($line)); } } else { confess "Please provide a filename/filehandle to parse\n"; } foreach my $line (@CSV_Content) { unless ($line and $line !~ /^([,"']|\s)+$/) { # Skip empty lines next; } push(@{$self->{lines}}, $self->new_line(undef, { line => $line })); } } sub _do_parse_objects { my ($self, %opts) = @_; confess "Please specify objects as an ARRAY ref!\n" unless (ref $opts{objects} eq 'ARRAY'); foreach my $object (@{$opts{objects}}) { my $line = $self->new_line(); foreach my $field (@{$self->fields()}) { confess ((ref $object). " does not contain method ". $field. "\n") unless ($object->can($field)); $line->set( $field => $object->$field ); } push(@{$self->{lines}}, $line); } } sub new_line { my ($self, $args, $opts) = @_; my %opts = (); if ($opts and ref $opts eq 'HASH') { %opts = %{$opts}; } my $line = new Class::CSV::Line( fields => $self->fields(), csv_xs_options => $self->csv_xs_options(), %opts ); confess "Failed to create new line\n" unless ($line); if (defined $args) { if (ref $args eq 'ARRAY') { my @dr_array = @{$args}; foreach my $field (@{$self->fields()}) { my $value = shift @dr_array; $line->set( $field => $value ); } } elsif (ref $args eq 'HASH') { foreach my $field (keys %{$args}) { $line->set( $field => $args->{$field} ); } } else { confess "Need the arguments passed as either an ARRAY ref or a HASH ref!\n"; } } return $line; } sub add_line { my ($self, $args) = @_; confess "Cannot call add_line without an argument!\n" unless (defined $args and $args); my $line = $self->new_line($args); push(@{$self->{lines}}, $line); } sub string { my ($self) = @_; confess "No lines to write!\n" unless (ref $self->lines() eq 'ARRAY'); my @string = (); map { push(@string, $_->string()); } @{$self->lines()}; return join($self->line_separator(), @string). $self->line_separator(); } sub print { my ($self) = @_; print $self->string(); } sub strip_crlf { my ($self, $string) = @_; $string =~ s/[\n\r]+$//g; return $string; } sub _private_set { my ($self, %items) = @_; foreach my $field (keys %items) { $self->{$field} = $items{$field}; $self->{__fields}->{$field} = TRUE; } } 1; __END__ =head1 NAME Class::CSV - Class based CSV parser/writer =head1 SYNOPSIS use Class::CSV; my $csv = Class::CSV->parse( filename => 'test.csv', fields => [qw/item qty sub_total/] ); foreach my $line (@{$csv->lines()}) { $line->sub_total('$'. sprintf("%0.2f", $line->sub_total())); print 'Item: '. $line->item(). "\n". 'Qty: '. $line->qty(). "\n". 'SubTotal: '. $line->sub_total(). "\n"; } my $cvs_as_string = $csv->string(); $csv->print(); my $csv = Class::CSV->new( fields => [qw/userid username/], line_separator => "\r\n"; ); $csv->add_line([2063, 'testuser']); $csv->add_line({ userid => 2064, username => 'testuser2' }); =head1 DESCRIPTION This module can be used to create objects from I files, or to create I files from objects. L is used for parsing and creating I file lines, so any limitations in L will of course be inherant in this module. =head2 EXPORT None by default. =head1 METHOD =head2 CONSTRUCTOR =over =item B the parse constructor takes a hash as its paramater, the various options that can be in this hash are detailed below. =over 4 =item B =over 4 =item * B - an array ref containing the list of field names to use for each row. there are some reserved words that cannot be used as field names, there is no checking done for this at the moment but it is something to be aware of. the reserved field names are as follows: C, C, C. also field names cannot contain whitespace or any characters that would not be allowed in a method name. =back =item B (only one of these is needed) =over 4 =item * B - the path of the I file to be opened and parsed. =item * B - the file handle of the I file to be parsed. =item * B - an array ref of objects (e.g. L objects). for this to work properly the field names provided in B needs to correspond to the field names of the objects in the array ref. =item * B - B use objects instead - using classdbi_objects will still work but its advisable to update your code. =back =item B =over 4 =item * B - the line seperator to be included at the end of every line. defaulting to C<\n> (unix carriage return). =back =back =item B the I constructor takes a hash as its paramater, the same options detailed in B apply to I however no B can be used. this constructor creates a blank I object of which lines can be added via B. =back =head2 ACCESSING =over =item B returns an array ref containing objects of each I line (made via L). the field names given upon construction are available as accessors and can be I or I. for more information please see the notes below or the perldoc for L. the B accessor is also able to be updated/retrieved in the same way as individual lines fields (examples below). =over 4 =item B retrieving the lines: =over 4 my @lines = @{$csv->lines()}; =back removing the first line: =over 4 pop @lines; $csv->lines(\@lines); =back sorting the lines: =over 4 @lines = sort { $a->userid() <=> $b->userid() } @lines: $csv->lines(\@lines); =back sorting the lines (all-in-one way): =over 4 $csv->lines([ sort { $a->userid() <=> $b->userid() } @{$csv->lines()} ]); =back =item B there is two ways to retrieve a fields value (as documented in L). firstly you can call the field name on the object and secondly you can call C on the object with the field name as the argument (multiple field names can be specified to retrieve an array of values). examples are below. =over 4 my $value = $line->test(); =back I =over 4 my $value = $line->get('test'); =back I =over 4 my @values = $line->get(qw/test test2 test3/); =back =item B setting a fields value is simmilar to getting a fields value. there are two ways to set a fields value (as documented in L). firstly you can simply call the field name on the object with the value as the argument or secondly you can call C on the object with a hash of fields and their values to set (this isn't standard in L, i have overloaded the C method to allow this). examples are below. =over 4 $line->test('123'); =back I =over 4 $line->set( test => '123' ); =back I =over 4 $line->set( test => '123', test2 => '456' ); =back =item B to retrieve a line as a string simply call C on the object. =over 4 my $string = $line->string(); =back =back =item B returns a new line object, this can be useful for to C a line into B (see example below). you can pass the values of the line as an I ref or a I ref. =over 4 =item B my $line = $csv->new_line({ userid => 123, domainname => 'splicey.com' }); my @lines = $csv->lines(); splice(@lines, 1, 0, $line); I splice(@{$csv->lines()}, 1, 0, $csv->new_line({ userid => 123, domainname => 'splicey.com' })); =back =item B adds a line to the B stack. this is mainly useful when the B constructor is used but can of course be used with any constructor. it will add a new line to the end of the B stack. you can pass the values of the line as an I ref or a I ref. examples of how to use this are below. =over 4 =item B $csv->add_line(['house', 100000, 4]); $csv->add_line({ item => 'house', cost => 100000, bedrooms => 4 }); =back =back =head2 OUTPUT =over =item B returns the object as a string (I file format). =item B calls C on B (prints the I to STDOUT). =back =head1 SEE ALSO L, L =head1 AUTHOR David Radunz, Edavid@boxen.netE =head1 COPYRIGHT AND LICENSE Copyright 2004 by David Radunz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Class-CSV-1.03/META.yml0100644000206400017500000000067610562510014013546 0ustar davidrutiba--- #YAML:1.0 name: Class-CSV version: 1.03 abstract: ~ license: ~ generated_by: ExtUtils::MakeMaker version 6.31 distribution_type: module requires: Class::Accessor: 0.18 Text::CSV_XS: 0.23 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - David Radunz Class-CSV-1.03/Changes0100644000206400017500000000027210212737527013574 0ustar davidrutibaRevision history for Perl extension Netspace::Class::CSV. 0.01 Mon Apr 5 14:14:54 2004 - original version; created by h2xs 1.22 with options -b5.6.1 -A -X -n Netspace::Class::CSV Class-CSV-1.03/README0100644000206400017500000000207010212737624013155 0ustar davidrutibaClass/CSV version 0.01 =============================== The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: blah blah blah COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2004 David Radunz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Class-CSV-1.03/Makefile.PL0100644000206400017500000000077410212737600014252 0ustar davidrutibause 5.006001; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Class::CSV', 'VERSION_FROM' => 'CSV.pm', # finds $VERSION 'PREREQ_PM' => { Text::CSV_XS => 0.23, Class::Accessor => 0.18 }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (AUTHOR => 'David Radunz ') : ()), );