File Coverage

blib/lib/XML/SAXDriver/CSV.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package XML::SAXDriver::CSV;

use strict;

use Text::CSV_XS;

use base qw(XML::SAX::Base);
use vars qw($VERSION $NS_SAXDriver_CSV);
$VERSION = '0.07';
$NS_SAXDriver_CSV = 'http://xmlns.perl.org/sax/XML::SAXDriver::CSV';

sub _parse_bytestream
{
  my $self = shift;
  my $stream = shift;

  $self->_parse_CSV(\$stream);
}
sub _parse_string
{
  my $self = shift;
  my $stream = shift;

  my @strings = split("\n", $self->{ParseOptions}->{Source}{String});
  $self->_parse_CSV(\@strings);
}
sub _parse_systemid
{
  my $self = shift;
  my $path = shift;

  require IO::File;
  my $ioref = IO::File->new($self->{ParseOptions}->{Source}{SystemId})
               || die "Cannot open SystemId '$self->{ParseOptions}->{Source}{SystemId}' : $!";

  $self->_parse_CSV($ioref);
}

sub _parse_CSV
{

  my $self = shift;
  my $source = shift;

  $self->{ParseOptions}->{Parser} ||= Text::CSV_XS->new();

  $self->{ParseOptions}->{Declaration}->{Version} ||= '1.0';

  my $document = {};
  $self->start_document($document);
  $self->xml_decl($self->{ParseOptions}->{Declaration});
  my $pm_csv = $self->_create_node(
                                  Prefix       => 'SAXDriver::CSV',
                                  NamespaceURI => $NS_SAXDriver_CSV,
                                  );
  $self->start_prefix_mapping($pm_csv);
  $self->end_prefix_mapping($pm_csv);

  my $doc_element = {
              Name => $self->{ParseOptions}->{File_Tag} || "records",
              Attributes => {},
          };

  $self->start_element($doc_element);

  $self->{ParseOptions}->{Col_Headings} ||= [];

  $self->{ParseOptions}->{Headings_Handler} ||= \&_normalize_heading;

  while (my $row = _get_row($self->{ParseOptions}->{Parser}, $source)) {
      my $el = {
          Name => $self->{ParseOptions}->{Parent_Tag} || "record",
          Attributes => {},
      };

      if (!@{$self->{ParseOptions}->{Col_Headings}} && !$self->{ParseOptions}->{Dynamic_Col_Headings})
      {
              my $i = 1;
              @{$self->{ParseOptions}->{Col_Headings}} = map { "column" . $i++ } @$row;
      }
      elsif (!@{$self->{ParseOptions}->{Col_Headings}} && $self->{ParseOptions}->{Dynamic_Col_Headings})
      {
              @{$self->{ParseOptions}->{Col_Headings}} = map { $self->{ParseOptions}->{Headings_Handler}->($_, $self->{ParseOptions}->{SubChar}); } @$row;
              next; # causes the first (heading) row to be skipped

      }

      $self->start_element($el);

      for (my $i = 0; $i <= $#{$row}; $i++) {
          my $column = { Name => $self->{ParseOptions}->{Col_Headings}->[$i], Attributes => {} };

          $self->start_element($column);
          $self->characters({Data => $row->[$i]});
          $self->end_element($column);
      }

      $self->end_element($el);
  }

  $self->end_element($doc_element);

  return $self->end_document($document);
}

sub _normalize_heading  ### Default if no Headings_Handler is provided
{
  my $heading= shift;
  my $sub_char = shift || '_';
  $heading =~ s/^\s//g;
  $heading =~ s/\s$//g;
  $heading =~ s/^([^a-zA-Z|^_|^:])/$sub_char/g;   ### We used to also replace the xml in the beginning, but I took it of per recommendation of Michael Rodriguez.
  $heading =~ s/[^a-zA-Z|^-|^.|^0-9|^:]/$sub_char/g;
  return $heading;
}

sub _get_row {
    my ($parser, $source, $strings) = @_;

    if (ref($source) eq "ARRAY")
    {
      my $line = shift @$source;
      if ($line && $parser->parse($line)) {
        return [$parser->fields()];
      }
    }
    else
    {
      my $line = <$source>;
      if ($line && $parser->parse($line)) {
        return [$parser->fields()];
      }
    }

    return;
}

sub _create_node {
    shift;
    # this may check for a factory later
    return {@_};
}

1;
__END__