site/cgi-bin/modules/BSE/Importer/Source/CSV.pm

   1 package BSE::Importer::Source::CSV;
   2 use strict;
   3 use base 'BSE::Importer::Source::Base';
   4 use Text::CSV;
   5
   6 our $VERSION = "1.000";
   7
   8 my @text_csv_options = qw(quote_char escape_char sep_char binary allow_loose_quotes allow_loose_escapes allow_whitespace);
   9
  10 my @escape_options = qw(quote_char escape_char sep_char);
  11
  12 =head1 NAME
  13
  14 BSE::Importer::Source::CSV - import source for CSV files.
  15
  16 =head1 SYNOPSIS
  17
  18    [import profile foo]
  19    source=CSV
  20    ; these are the defaults
  21    skiplines=1
  22    binary=1
  23    quote_char="
  24    sep_char=,
  25    escape_char="
  26    allow_loose_quotes=0
  27    allow_loose_escaped=0
  28    allow_whitespace=0
  29    encoding=utf-8
  30
  31 =head1 DESCRIPTION
  32
  33 Uses CSV (comma separated values) text files a data source.
  34
  35 =head1 CONFIGURATION
  36
  37 The following extra configuration can be set in the profile's
  38 configuration, (mostly better described in L<Text::CSV>.
  39
  40 =over
  41
  42 =item *
  43
  44 C<skiplines> - the number of lines for skip at the top, eg. for column
  45 headings.  Default: 1.
  46
  47 =item *
  48
  49 C<binary> - whether the file should be treated as binary.  The default
  50 is typically correct. Default: 1.
  51
  52 =item *
  53
  54 C<sep_char> - the separator character between columns.  Default: ",".
  55 To use tab:
  56
  57   sep_char=\t
  58
  59 =item *
  60
  61 C<allow_whitespace> - set to true to ignore whitespace around the
  62 separator.  Default: 0.
  63
  64 =item *
  65
  66 C<encoding> - the character encoding to use in the input text.
  67 Default: "utf-8".
  68
  69 =item *
  70
  71 C<quote_char> - the character used for quoting fields containing
  72 blanks or separators.  Default: '"'.
  73
  74 =item *
  75
  76 C<escape_char> - the character used for quote escapes.  Default: '"'.
  77
  78 =back
  79
  80 =cut
  81
  82 sub new {
  83   my ($class, %opts) = @_;
  84
  85   my $self = $class->SUPER::new(%opts);
  86
  87   my $importer = delete $opts{importer};
  88   my $opts = delete $opts{opts};
  89
  90   $self->{skiplines} = $importer->cfg_entry('skiplines', 1);
  91
  92   $self->{encoding} = $importer->cfg_entry('encoding', 'utf-8');
  93   my %csv_opts = ( binary => 1 );
  94   for my $opt (@text_csv_options) {
  95     my $val = $importer->cfg_entry($opt);
  96     defined $val and $csv_opts{$opt} = $val;
  97   }
  98
  99   for my $opt (@escape_options) {
 100     if (defined (my $val = $csv_opts{$opt})) {
 101       if ($val =~ /\A\\(?:[nrtfbae]|x[0-9a-fA-F]{2}|[0-7]{1,3}|c.)\z/) {
 102         $csv_opts{$opt} = eval '"' . $val . '"';
 103       }
 104     }
 105   }
 106
 107   $self->{csv_opts} = \%csv_opts;
 108
 109   return $self;
 110 }
 111
 112 sub each_row {
 113   my ($self, $importer, $filename) = @_;
 114
 115   open my $fh, "<encoding($self->{encoding})", $filename
 116     or die "Cannot open file $filename: $!\n";
 117
 118   my $csv = Text::CSV->new($self->{csv_opts})
 119     or die "Cannot use CSV: ", Text::CSV->error_diag(), "\n";
 120
 121   for my $line (1 .. $self->{skiplines}) {
 122     my $row = $csv->getline($fh);
 123     if (!$row) {
 124       if ($csv->eof) {
 125         die "Ran out of rows reading the headers\n";
 126       }
 127       else {
 128         die "Error reading header rows: ", $csv->error_diag, "\n";
 129       }
 130     }
 131   }
 132
 133   while (my $row = $csv->getline($fh)) {
 134     $self->{row} = $row;
 135     $self->{line} = $.;
 136     $importer->row($self);
 137   }
 138 }
 139
 140 sub get_column {
 141   my ($self, $colnum) = @_;
 142
 143   $colnum > @{$self->{row}}
 144     and return '';
 145
 146   return $self->{row}[$colnum-1];
 147 }
 148
 149 sub rowid {
 150   my $self = shift;
 151
 152   return "Line " . $self->{line};
 153 }
 154
 155 1;
 156
 157 =head1 AUTHOR
 158
 159 Tony Cook <tony@develop-help.com>
 160
 161 =head1 SEE ALSO
 162
 163 L<BSE::Importer>
 164
 165 =cut