IO::CSVHeaderFile - Perl extension for CSV Files

  # to read ...
  use IO::CSVHeaderFile;
  my $csv = IO::CSVHeaderFile->new( "< $filename" );
  while(my $hash = $csv->csv_read ){
  	print "$hash->{ColHeaderTitle}\n";
  }
  $csv->close;

  # or for same named columns
  my $csv = IO::CSVHeaderFile->new( "< $filename" );
  my $data;
  while(@array = $csv->csv_read ){
  	for(my $i=0; $i< @array; $i++) {
  		print "Column '$array[$i]': $array[$i]\n";
  	}
  	print "-- end of record\n";
  }
  $csv->close;

  


  # to write ...
  use IO::CSVHeaderFile;
  my $csv = IO::CSVHeaderFile->new( "> $filename" , 
  	{col => ['ColHeaderTitle1','ColHeaderTitle2','ColHeaderTitle1'], noheaders => 1} );
    $csv->csv_print({ColHeaderTitle1 => 'First', ColHeaderTitle2 => 'Second'}) or return;
    $csv->csv_print(['Uno', 'Duo', 'Tre']) or return;
    $csv->csv_print(
    	ColHeaderTitle1 => 'One',
    	ColHeaderTitle2 => 'Two',
    	ColHeaderTitle1 => 'Three with the same name as One'
    	) or return;
  $csv->close;

package IO::CSVHeaderFile;
# $Id: CSVHeaderFile.pm,v 1.2 2007/07/06 08:44:46 vasek Exp $

use strict;
use Text::CSV_XS;
use IO::File;
use vars qw(@ISA @EXPORT $VERSION);
use Exporter;
use Carp;

@ISA = qw(IO::File Exporter);

@EXPORT = qw(
        
);

$VERSION = '0.04';

my $SUPPORTED_XS_ARGS;

sub open {
	my $self = shift;
	my $args = {}; $args = pop @_ if ref($_[$#_]) eq 'HASH';
	_init_supported_xs_args();
	my %xs_args = ( 'eol' => "\n", map {exists $SUPPORTED_XS_ARGS->{$_} ? ($_ => $args->{$_}):()} keys %$args);
	my $csv = Text::CSV_XS->new(\%xs_args);
	my $mode;
	if(@_ > 1){
		croak 'usage: $fh->open(FILENAME [ ,< > >> ][,CSVOPT])' if $_[2] =~ /^\d+$/;
		$mode = IO::Handle::_open_mode_string($_[1]);
	}else{
		$mode = $_[0];
		$mode =~ s/^(\+?<|>>?)(.*)$/$1/ 
			or croak 'usage: $fh->open(FILENAME [,< > >> ][,CSVOPT])';
	}
	my ($fh, $firstline);
	if($mode =~ /^<$/){
		$fh = $self->SUPER::open( @_ ) or return;
		unless($args->{noheader}){
			unless( $firstline = $self->getline ){
				$self->close;
				return;
			}
			$csv->parse($firstline) and $args->{col} = [ $csv->fields ]
				unless $args->{col};
		}
		unless(${*$self}{io_csvheaderfile_cols} = $args->{col}){
			$self->close;
			croak "IO::CSVHeaderFile: Can't find the column names in '$_[0]'";
			return;
		}	
	}elsif( $mode =~ /^>>?$/){
		unless(${*$self}{io_csvheaderfile_cols} = $args->{col}){
			$self->close;
			croak "IO::CSVHeaderFile: Can't find the column names in '$_[0]'";
			return;
		}
		$fh = $self->SUPER::open( @_ ) or return;
		$csv->print($self, $args->{col})
			unless $mode =~ /^>>$/ or $args->{noheader};
	}else{
		croak "IO::CSVHeaderFile: Invalid mode '$mode'";
		return;
	}
	${*$self}{io_csvheaderfile_csv} = $csv;
	$fh
}

sub csv_read{
	my $self = shift;
	my $line = $self->getline() or return;
	my @result = ();
	if( ${*$self}{io_csvheaderfile_csv}->parse($line) ){
		my @cols = ${*$self}{io_csvheaderfile_csv}->fields;
		my $colnames = ${*$self}{io_csvheaderfile_cols};
		my $avail_cols = (@cols > @$colnames)? @$colnames : @cols;
		for(my $i = 0; $i < $avail_cols; $i++){
			push @result, $colnames->[$i] => $cols[$i];
		}
	}
	wantarray? @result : { @result }
}

sub csv_print{
	my $self = shift;
	return undef unless @_;
	my $rec = $_[0];
	my @columns = ();
	my $colnames = ${*$self}{io_csvheaderfile_cols};
	unless( ref $rec ){
		my %map = ();
		for(my $i = 0; $i < @$colnames; $i++){
			$map{$colnames->[$i]} = [] unless exists $map{$colnames->[$i]};
			push @{$map{$colnames->[$i]}}, $i;
		}
		while ( my ($key, $value) = splice(@_, 0, 2) ) {
			my $idx = $map{$key} or next;
			$columns[$idx->[0]] = $value;
			shift @$idx if @$idx > 1;
		}
	}elsif( ref ($rec) eq 'HASH' ){
		push( @columns, $rec->{$_}) foreach (@$colnames);		
	}elsif( ref ($rec) eq 'ARRAY' ){
		for( my $i = 0; $i < @$colnames; $i++){
			push @columns, $rec->[$i];
		}
	}
	${*$self}{io_csvheaderfile_csv}->print($self,\@columns);
}

sub _init_supported_xs_args {
	return if defined $SUPPORTED_XS_ARGS;
	my $tmpcsvxs = Text::CSV_XS->new();
	$SUPPORTED_XS_ARGS = UNIVERSAL::isa($tmpcsvxs, "HASH")?
		{%$tmpcsvxs}: {map {$_ => undef} qw(eol sep_char allow_whitespace quote_char
		allow_loose_quotes escape_char allow_loose_escapes binary types always_quote 
		keep_meta_info)};
}

1;
__END__
# Below is stub documentation for your module. You better edit it!