File Coverage

blib/lib/PDL/IO/XLSX.pm

Criterion	Covered	Total	%
statement	21	23	91.3
branch	1	2	50.0
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	33	90.9

package PDL::IO::XLSX;
use 5.010;
use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK   = qw(rxlsx1D rxlsx2D wxlsx1D wxlsx2D);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

our $VERSION = '0.003';

use Config;
use constant DEBUG => $ENV{PDL_IO_XLSX_DEBUG} ? 1 : 0;

use PDL;
use PDL::IO::XLSX::Writer;
use PDL::IO::XLSX::Reader;
use Scalar::Util qw(looks_like_number blessed);

use Carp;
$Carp::Internal{ (__PACKAGE__) }++;

sub import {
  my $package = shift;
  {
    no strict 'refs';
    *{'PDL::wxlsx2D'} = \&wxlsx2D if grep { /^(:all|wxlsx2D)$/ } @_;
    *{'PDL::wxlsx1D'} = \&wxlsx1D if grep { /^(:all|wxlsx1D)$/ } @_;
  }
  __PACKAGE__->export_to_level(1, $package, @_) if @_;
}

my %pck = (
  byte     => "C",
  short    => "s",
  ushort   => "S",
  long     => "l",
  longlong => "q",
  float    => "f",
  double   => "d",
);

sub _serialdate2longlong {
  my $v = shift; # MS Excel serial datetime
  my $epoch_miliseconds_float = ($v - 25569) * 24 * 60 * 60 * 1000;
  return 1000 * int POSIX::floor($epoch_miliseconds_float + 0.5); # longlong epoch microseconds
}

sub _longlong2serialdate {
  my $v = shift;
  # return MS Excel serial datetime (with microsecond-only precision)
  return 25569 + ( int($v / 1000) / (24 * 60 * 60 * 1000) );
}

sub wxlsx1D {
  my ($fh, $O, $C) = _proc_wargs('1D', @_);

  my $cols = 0;
  my $rows = 0;
  my @c_pdl;
  my @c_rows;
  my @c_type;
  my @c_size;
  my @c_pack;
  my @c_dataref;
  my @c_offset;
  my @c_max_offset;
  my @c_bad;

  my %alias = (
    '%Y-%m-%d'              => [ 10, 'yyyy\-mm\-dd' ],
    '%Y-%m-%dT%H:%M'        => [ 16, 'yyyy\-mm\-dd\ hh:mm' ],
    '%Y-%m-%dT%H:%M:%S'     => [ 19, 'yyyy\-mm\-dd\ hh:mm:ss' ],
    '%Y-%m-%dT%H:%M:%S.%3N' => [ 23, 'yyyy\-mm\-dd\ hh:mm:ss.000' ],
    '%Y-%m-%dT%H:%M:%S.%6N' => [ 23, 'yyyy\-mm\-dd\ hh:mm:ss.000' ],
  );

  my $bad2empty = $O->{bad2empty};

  my @xlsx_format_array;
  my %xlsx_width_hash;

  while (blessed $_[0] && $_[0]->isa('PDL')) {
    $c_pdl[$cols] = shift;
    croak "FATAL: wxlsx1D() expects 1D piddles" unless $c_pdl[$cols]->ndims == 1;
    $c_size[$cols]       = PDL::Core::howbig($c_pdl[$cols]->get_datatype);
    $c_dataref[$cols]    = $c_pdl[$cols]->get_dataref;
    $c_offset[$cols]     = 0;
    my $type             = $c_pdl[$cols]->type;
    my $dim              = $c_pdl[$cols]->dim(0);
    $c_pack[$cols]       = $pck{$type};
    $c_max_offset[$cols] = $c_size[$cols] * $dim;
    $rows = $dim if $rows < $dim;
    if ($bad2empty && $c_pdl[$cols]->check_badflag) {
      my $b = pdl($type, 1)->setbadif(1);
      my $d = $b->get_dataref;
      $c_bad[$cols] = substr($$d, 0, $c_size[$cols]); # raw bytes representind BAD value
    }
    if (ref $c_pdl[$cols] eq 'PDL::DateTime') {
      my $strf = $c_pdl[$cols]->_autodetect_strftime_format; #XXX-TODO _autodetect_strftime_format is a hack!!
      my ($len, $fmt) = @{$alias{$strf}};
      if (defined $len && defined $fmt) {
        $xlsx_format_array[$cols] = $fmt; # 0-based index
        $xlsx_width_hash{$cols + 1} = $len ; # 1-based index
      }
    }
    $cols++;
  }

  my $xlsx = PDL::IO::XLSX::Writer->new(%$C);
  $xlsx->sheets->start($O->{sheet_name} // "Sheet1", \%xlsx_width_hash, \@xlsx_format_array);

  if (ref $O->{header} eq 'ARRAY') {
    croak "FATAL: wrong header (expected $cols items)" if $cols != scalar @{$O->{header}};
    $xlsx->sheets->add_row($O->{header}); #XXX-TODO apply a special style for header cells (gray background)
  }

  for my $r (0..$rows-1) {
    my @v = ('') x $cols;
    for my $c (0..$cols-1) {
      if ($c_max_offset[$c] >= $c_offset[$c]) {
        if ($bad2empty && $c_bad[$c]) {
          my $v = substr(${$c_dataref[$c]}, $c_offset[$c], $c_size[$c]);
          if ($v ne $c_bad[$c]) {
            $v[$c] = unpack($c_pack[$c], $v);
            $v[$c] = _longlong2serialdate($v[$c]) if ref $c_pdl[$c] eq 'PDL::DateTime';
          }
        }
        else {
          my $v = substr(${$c_dataref[$c]}, $c_offset[$c], $c_size[$c]);
          $v[$c] = unpack($c_pack[$c], $v);
          $v[$c] = _longlong2serialdate($v[$c]) if ref $c_pdl[$c] eq 'PDL::DateTime';
        }
      }
      $c_offset[$c] += $c_size[$c];
    }
    $xlsx->sheets->add_row(\@v);
  }
  $xlsx->sheets->save;
  $xlsx->xlsx_save($fh, $C->{overwrite});
}

sub wxlsx2D {
  my $pdl = shift;
  my ($fh, $O, $C) = _proc_wargs('2D', @_);

  croak "FATAL: wxlsx2D() expects 2D piddle" unless $pdl->ndims == 2;
  my $p = $pdl->transpose;

  my ($cols, $rows) = $p->dims;
  my $type = $p->type;
  my $size = PDL::Core::howbig($p->get_datatype);
  my $packC = $pck{$type} . "[$cols]";
  my $pack1 = $pck{$type};
  my $dataref = $p->get_dataref;
  my $offset = 0;
  my $colsize = $size * $cols;
  my $max_offset = $colsize * ($rows - 1);
  my $bad;
  if ($O->{bad2empty} && $p->check_badflag) {
    my $b = pdl($type, 1)->setbadif(1);
    my $d = $b->get_dataref;
    $bad = substr($$d, 0, $size); # raw bytes representing BAD value
  }

  my $xlsx = PDL::IO::XLSX::Writer->new(%$C);
  $xlsx->sheets->start($O->{sheet_name} // "Sheet1");

  if ($O->{header}) {
    my $n = scalar @{$O->{header}};
    croak "FATAL: wrong header (expected $cols items, got $n)" if $cols != $n;
    $xlsx->sheets->add_row($O->{header});
  }
  while ($offset <= $max_offset) {
    if (defined $bad) {
      my @v = map { my $v = substr($$dataref, $offset + $_*$size, $size); $v eq $bad ? '' : unpack($pack1, $v) } (0..$cols-1);
      $xlsx->sheets->add_row(\@v);
    }
    else {
      my @v = unpack($packC, substr($$dataref, $offset, $colsize));
      $xlsx->sheets->add_row(\@v);
    }
    $offset += $colsize;
  }
  $xlsx->sheets->save;

  $xlsx->xlsx_save($fh, $C->{overwrite});
}

sub rxlsx1D {
  my ($fh, $coli, $O, $C) = _proc_rargs('1D', @_);

  my ($c_type, $c_pack, $c_sizeof, $c_pdl, $c_bad, $c_dataref, $c_idx, $c_dt, $allocated, $cols); # initialize after we get 1st line

  my $xlsx = PDL::IO::XLSX::Reader->new($fh, %$C);
  my $processed = 0;
  my $finished = 0;
  my $reshape_inc = $O->{reshape_inc};
  my $empty2bad = $O->{empty2bad};
  my $text2bad  = $O->{text2bad};

  my $headerline;
  my $auto_detect_headerline;
  my $skip_before_headerline;
  my $rows = 0;
  my @bytes;

  if (looks_like_number($O->{header}) && $O->{header} >= 1) {
    $skip_before_headerline = $O->{header} - 1;
  }
  elsif (($O->{header}//'') eq 'auto') {
    $auto_detect_headerline = 1;
  }

  my $proc_line = sub {
        my $r = shift;
        my $f = shift;
        if (defined $r) {
          if (defined $skip_before_headerline) {
            if ($skip_before_headerline == 0) {
              $headerline = $r;
              $skip_before_headerline = undef;
            }
            else {
              $skip_before_headerline--;
            }
            return; # go to the next line
          }
          elsif (defined $auto_detect_headerline) {
            my $numeric = 0;
            for (@$r) { $numeric++ if looks_like_number($_) || defined PDL::DateTime::dt2ll($_) }
            if ($numeric == 0) {
              # no numeric values found => skip this line but keep it as a potential header
              $headerline = $r;
              return; # go to the next line
            }
            $auto_detect_headerline = undef;
          }
          unless (defined $c_type) {
            ($c_type, $c_pack, $c_sizeof, $c_pdl, $c_bad, $c_dataref, $c_idx, $c_dt, $allocated, $cols) = _init_1D($coli, $r, $f, $O);
            warn "Initialized size=$allocated, cols=$cols, type=".join(",",@$c_type)."\n" if $O->{debug};
          }
          if ($empty2bad) {
            if (defined $coli) {
              for (0..$cols-1) {
                my $i = $coli->[$_];
                unless (defined $r->[$i]) { $r->[$i] = $c_bad->[$_]; $c_pdl->[$_]->badflag(1) }
              }
            }
            else {
              for (0..$cols-1) {
                unless (defined $r->[$_]) { $r->[$_] = $c_bad->[$_]; $c_pdl->[$_]->badflag(1) }
              }
            }
          }
          if (defined $c_dt) {
            for (0..$cols-1) {
              next unless defined $c_dt->[$_];
              my $v = _serialdate2longlong($r->[$_]);
              if (defined $v) {
                $r->[$_] = $v;
              }
              else {
                $r->[$_] = $c_bad->[$_];
                $c_pdl->[$_]->badflag(1);
              }
            }
          }
          if ($text2bad) {
            if (defined $coli) {
              for (0..$cols-1) {
                my $i = $coli->[$_];
                unless (looks_like_number($r->[$i])) { $r->[$i] = $c_bad->[$_]; $c_pdl->[$_]->badflag(1) }
              }
            }
            else {
              for (0..$cols-1) {
                unless (looks_like_number($r->[$_])) { $r->[$_] = $c_bad->[$_]; $c_pdl->[$_]->badflag(1) }
              }
            }
          }
          if (defined $coli) { # only selected columns
            no warnings 'pack'; # intentionally disable all pack related warnings
            no warnings 'numeric'; # disable: Argument ??? isn't numeric in pack
            no warnings 'uninitialized'; # disable: Use of uninitialized value in pack
            $bytes[$_] .= pack($c_pack->[$_], $r->[$coli->[$_]]) for (0..$cols-1);
          }
          else { # all columns
            no warnings 'pack'; # intentionally disable all pack related warnings
            no warnings 'numeric'; # disable: Argument ??? isn't numeric in pack
            no warnings 'uninitialized'; # disable: Use of uninitialized value in pack
            $bytes[$_] .= pack($c_pack->[$_], $r->[$_]) for (0..$cols-1);
          }
          $rows++;
        }
        if ($rows >= $reshape_inc || !defined $r) {
          $processed += $rows;
          if (!defined $r) {
            # flush/finalize
            $allocated = $processed;
            warn "Reshape to: '$allocated'\n" if $O->{debug};
            for (0..$cols-1) {
              $c_pdl->[$_]->reshape($allocated);
              $c_dataref->[$_] = $c_pdl->[$_]->get_dataref;
            }
          }
          elsif ($allocated < $processed) {
            $allocated += $reshape_inc;
            warn "Reshape to: '$allocated'\n" if $O->{debug};
            for (0..$cols-1) {
              $c_pdl->[$_]->reshape($allocated);
              $c_dataref->[$_] = $c_pdl->[$_]->get_dataref;
            }
          }
          for my $ci (0..$cols-1) {
            my $len = length $bytes[$ci];
            my $expected_len = $c_sizeof->[$ci] * $rows;
            croak "FATAL: len mismatch $len != $expected_len" if $len != $expected_len;
            substr(${$c_dataref->[$ci]}, $c_idx->[$ci], $len) = $bytes[$ci];
            $c_idx->[$ci] += $expected_len;
          }
          @bytes = ();
          $rows = 0;
          if (!defined $r) {
            # flush/finalize
            $c_pdl->[$_]->upd_data for (0..$cols-1);
          }
        }
  };

  warn "Fetching 1D " . _dbg_msg($O, $C) . "\n" if $O->{debug};
  if ($O->{sheet_name}) {
    $xlsx->parse_sheet_by_name($O->{sheet_name}, sub {
      my $r = [ map { $_->{v} } @{$_[0]} ]; #values
      my $f = [ map { $_->{f} } @{$_[0]} ]; #formats
      $proc_line->($r, $f);
    });
  }
  else {
    $xlsx->parse_sheet_by_id(1, sub {
      my $r = [ map { $_->{v} } @{$_[0]} ]; #values
      my $f = [ map { $_->{f} } @{$_[0]} ]; #formats
      $proc_line->($r, $f);
    });
  }

  $proc_line->(undef); # flush/finalize
  if (ref $headerline eq 'ARRAY') {
    for (0..$cols-1) {
      $c_pdl->[$_]->hdr->{col_name} = $headerline->[$_] if $headerline->[$_] && $headerline->[$_] ne '';
    };
  }

  return @$c_pdl if ref $c_pdl eq 'ARRAY';
  warn "rxlsx1D: no data\n";
  return undef;
}

sub rxlsx2D {
  my ($fh, $coli, $O, $C) = _proc_rargs('2D', @_);

  my ($c_type, $c_pack, $c_sizeof, $c_pdl, $c_bad, $c_dataref, $allocated, $cols);
  my $xlsx = PDL::IO::XLSX::Reader->new($fh, %$C);
  my $processed = 0;
  my $c_idx = 0;
  my $pck;
  my $reshape_inc = $O->{reshape_inc};
  my $empty2bad = $O->{empty2bad};
  my $text2bad  = $O->{text2bad};
  my $bcount = 0;
  my $bytes = '';
  my $rows = 0;
  my $headers_to_skip = looks_like_number($O->{header}) ? $O->{header} : 0;
  my $formats;

  my $proc_line = sub {
        my $r = shift;
        if (defined $r) {
          if ($headers_to_skip > 0) {
            $headers_to_skip--;
            return;
          }
          unless (defined $pck) {
            ($c_type, $c_pack, $c_sizeof, $c_pdl, $c_bad, $c_dataref, $allocated, $cols) = _init_2D($coli, scalar @$r, $O);
            warn "Initialized size=$allocated, cols=$cols, type=$c_type\n" if $O->{debug};
            $pck = "$c_pack\[$cols\]";
          }
          if ($empty2bad) {
            if (defined $coli) {
              for (0..$cols-1) {
                my $i = $coli->[$_];
                if (($r->[$i]//'') eq '') {
                  $r->[$i] = $c_bad;
                  $c_pdl->badflag(1);
                }
              }
            }
            else {
              for (0..$cols-1) {
                if (($r->[$_]//'') eq '') {
                  $r->[$_] = $c_bad;
                  $c_pdl->badflag(1);
                }
              }
            }
          }
          if ($text2bad) {
            if (defined $coli) {
              for (0..$cols-1) {
                my $i = $coli->[$_];
                unless (looks_like_number($r->[$i])) { $r->[$i] = $c_bad; $c_pdl->badflag(1) }
              }
            }
            else {
              for (0..$cols-1) {
                unless (looks_like_number($r->[$_])) { $r->[$_] = $c_bad; $c_pdl->badflag(1) }
              }
            }
          }
          if (defined $coli) { # only selected columns
            no warnings 'pack'; # intentionally disable all pack related warnings
            no warnings 'numeric'; # disable: Argument ??? isn't numeric in pack
            no warnings 'uninitialized'; # disable: Use of uninitialized value in pack
            $bytes .= pack($pck, map { $r->[$_] } @$coli);
          }
          else { # all columns
            no warnings 'pack'; # intentionally disable all pack related warnings
            no warnings 'numeric'; # disable: Argument ??? isn't numeric in pack
            no warnings 'uninitialized'; # disable: Use of uninitialized value in pack
            $bytes .= pack($pck, @$r);
          }
          $rows++;
        }
        if ($rows >= $reshape_inc || !defined $r) {
          $processed += $rows;
          if (!defined $r) {
            # flush/finalize
            $allocated = $processed;
            warn "Reshaping to $allocated\n" if $O->{debug};
            $c_pdl->reshape($cols, $allocated);
            $c_dataref = $c_pdl->get_dataref;
          }
          elsif ($allocated < $processed) {
            $allocated += $reshape_inc;
            warn "Reshaping to $allocated\n" if $O->{debug};
            $c_pdl->reshape($cols, $allocated);
            $c_dataref = $c_pdl->get_dataref;
          }
          my $len = length $bytes;
          my $expected_len = $c_sizeof * $cols * $rows;
          croak "FATAL: len mismatch $len != $expected_len" if $len != $expected_len;
          substr($$c_dataref, $c_idx, $len) = $bytes;
          $c_idx += $len;
          $bytes = '';
          $rows = 0;
          if (!defined $r) {
            # flush/finalize
            $c_pdl->upd_data;
            $c_pdl = $c_pdl->transpose;
          }
        }
  };

  warn "Fetching 2D " . _dbg_msg($O, $C) . "\n" if $O->{debug};
  if ($O->{sheet_name}) {
    $xlsx->parse_sheet_by_name($O->{sheet_name}, sub {
      my $r = [ map { $_->{v} } @{$_[0]} ]; #values
      my $f = [ map { $_->{f} } @{$_[0]} ]; #formats
      $proc_line->($r, $f);
    });
  }
  else {
    $xlsx->parse_sheet_by_id(1, sub {
      my $r = [ map { $_->{v} } @{$_[0]} ]; #values
      my $f = [ map { $_->{f} } @{$_[0]} ]; #formats
      $proc_line->($r, $f);
    });
  }

  $proc_line->(undef); # flush/finalize

  warn "rxlsx2D: no data\n" unless blessed $c_pdl && $c_pdl->isa('PDL');
  return $c_pdl;
}

sub _dbg_msg {
  my ($O, $C) = @_;
  sprintf "reshape=%s, bad=%s/%s",
        $O->{reshape_inc} ||= '?',
        $O->{empty2bad}   ||= '?',
        $O->{text2bad}    ||= '?',
}

sub _proc_wargs {
  my $options        = ref $_[-1] eq 'HASH' ? pop : {};
  my $filename_or_fh = !blessed $_[-1] || !$_[-1]->isa('PDL') ? pop : undef;
  my $fn = shift;

  my $C = { %$options }; # make a copy

  my @keys = qw/ debug header bad2empty sheet_name /;
  my $O = { map { $_ => delete $C->{$_} } @keys };
  $O->{debug}     //= DEBUG;
  $O->{bad2empty} //= 1;
  $O->{header}    //= ($fn eq '1D' ? 'auto' : undef); #XXX-TODO backport to PDL::IO::CSV

  if (defined $O->{header}) {
    croak "FATAL: header should be arrayref" unless ref $O->{header} eq 'ARRAY' || $O->{header} eq 'auto';
    if ($O->{header} eq 'auto') {
      my @n;
      my $count = 0;
      for (@_) {
        push @n, my $n = $_->hdr->{col_name};
        $count++ if defined $n;
      }
      $O->{header} = $count > 0 ? \@n : undef;
    }
  }

  return ($filename_or_fh, $O, $C);
}

sub _proc_rargs {
  my $options = ref $_[-1] eq 'HASH' ? pop : {};
  my ($fn, $filename_or_fh, $coli) = @_;

  croak "FATAL: invalid column ids" if defined $coli && ref $coli ne 'ARRAY';
  croak "FATAL: invalid filename"   unless defined $filename_or_fh;
  my $C = { %$options }; # make a copy

  # get options related to this module the rest will be passed to PDL::IO::XLSX::Reader|Writer
  my @keys = qw/ reshape_inc type debug empty2bad text2bad header sheet_name /;
  my $O = { map { $_ => delete $C->{$_} } @keys };
  $O->{reshape_inc} ||= 80_000;
  $O->{type}        ||= ($fn eq '1D' ? 'auto' : double);  #XXX-TODO backport to PDL::IO::CSV
  $O->{header}      ||= ($fn eq '1D' ? 'auto' : 0);       #XXX-TODO backport to PDL::IO::CSV
  $O->{debug} = DEBUG unless defined $O->{debug};

  # empty2bad implies some PDL::IO::XLSX::Reader extra options
  if ($O->{empty2bad}) {
    $C->{blank_is_undef} = 1;
    $C->{empty_is_undef} = 1;
  }

  return ($filename_or_fh, $coli, $O, $C);
}

sub _init_1D {
  my ($coli, $firstline_v, $firstline_f, $O) = @_;
  my $colcount = scalar @$firstline_v;
  my $cols;
  if (!defined $coli) {    # take all columns
    $cols = $colcount;
  }
  else {
    $cols = scalar @$coli;
    ($_<0 || $_>$colcount) and croak "FATAL: invalid column '$_' (column count=$colcount)" for (@$coli);
  }
  croak "FATAL: invalid column count" unless $cols && $cols > 0 && $cols <= $colcount;

  my @c_type;
  my @c_pack;
  my @c_sizeof;
  my @c_pdl;
  my @c_bad;
  my @c_dataref;
  my @c_idx;

  if (ref $O->{type} eq 'ARRAY') {
    $c_type[$_] = $O->{type}->[$_] for (0..$cols-1);
  }
  else {
    $c_type[$_] = $O->{type} for (0..$cols-1);
  }

  for (0..$cols-1) {
    if (!defined $c_type[$_] || $c_type[$_] eq 'auto') {
      if ($firstline_f->[$_] =~ /^datetime\.(date|time|datetime)$/) {
        $c_type[$_] = 'datetime';
      }
      elsif ($firstline_f->[$_] eq 'int') {
        $c_type[$_] = longlong;
      }
      else {
        $c_type[$_] = double;
      }
    }
  }

  my @c_dt;
  for (0..$cols-1) {
    if ($c_type[$_] eq 'datetime') {
      $c_type[$_] = longlong;
      $c_dt[$_] = 'datetime';
    }
  }

  my $allocated = $O->{reshape_inc};
  for (0..$cols-1) {
    $c_type[$_] = double if !defined $c_type[$_];
    $c_pack[$_] = $pck{$c_type[$_]};
    croak "FATAL: invalid type '$c_type[$_]' for column $_" if !$c_pack[$_];
    $c_sizeof[$_] = length pack($c_pack[$_], 1);
    $c_pdl[$_] = $c_dt[$_] ? PDL::DateTime->new(zeroes(longlong, $allocated)) : zeroes($c_type[$_], $allocated);
    $c_dataref[$_] = $c_pdl[$_]->get_dataref;
    $c_bad[$_] = $c_pdl[$_]->badvalue;
    $c_idx[$_] = 0;
    my $big = PDL::Core::howbig($c_pdl[$_]->get_datatype);
    croak "FATAL: column $_ mismatch (type=$c_type[$_], sizeof=$c_sizeof[$_], big=$big)" if $big != $c_sizeof[$_];
  }

  return (\@c_type, \@c_pack, \@c_sizeof, \@c_pdl, \@c_bad, \@c_dataref, \@c_idx, (@c_dt > 0 ? \@c_dt : undef), $allocated, $cols);
}

sub _init_2D {
  my ($coli, $colcount, $O) = @_;

  my $cols;
  if (!defined $coli) {    # take all columns
    $cols = $colcount;
  }
  else {
    $cols = scalar @$coli;
    ($_<0 || $_>$colcount) and croak "FATAL: invalid column '$_' (column count=$colcount)" for (@$coli);
  }
  croak "FATAL: invalid column count" unless $cols && $cols > 0 && $cols <= $colcount;

  my $c_type = $O->{type};
  my $c_pack = $pck{$c_type};
  croak "FATAL: invalid type '$c_type' for column $_" if !$c_pack;

  my $allocated = $O->{reshape_inc};
  my $c_sizeof = length pack($c_pack, 1);
  my $c_pdl = zeroes($c_type, $cols, $allocated);
  my $c_dataref = $c_pdl->get_dataref;
  my $c_bad = $c_pdl->badvalue;

  my $big = PDL::Core::howbig($c_pdl->get_datatype);
  croak "FATAL: column $_ size mismatch (type=$c_type, sizeof=$c_sizeof, big=$big)" if $big != $c_sizeof;

  return ($c_type, $c_pack, $c_sizeof, $c_pdl, $c_bad, $c_dataref, $allocated, $cols);
}

1;

__END__