view release on metacpan or  search on metacpan

Table/Binary.pm  view on Meta::CPAN

  unless( $nbytes == $nread )
  {
    # gotta be exactly $nbytes or we're loused
    croak( "incomplete read of column ", $self->{last_col_idx} + 2, "\n" )
  }

  my @data = unpack( $col->ifmt . $ndata , $buf );

  # clean the data;
  unless ( $col->is_string )
  {
    $col->is_indef($_) && ($_ = undef) foreach @data;
  }

  $self->{last_col_idx}++;
  $self->{last_col} = $col;

  \@data;
}


sub read_row_row_array
{
  my $self = shift;
  $self->_read_next_row( @_ );
}



sub read_row_row_hash
{
  my $self = shift;
  my $row = shift || $self->{row_hash};

  my $row_arr = $self->_read_next_row( $row );

  return undef unless $row;

  @{$row}{ map { lc $_ } $self->{cols}->names } = @$row_arr;
  return $row;
}

# _read_row

# This reads the next row from a row-ordered table into an array, in the
# same order as that of the columns in the table.  Vector elements are
# stored as described above.  It returns the undefined value if there are
# no more data.

sub _read_next_row
{
  my $self = shift;

  my %attr = ( VecSplit => 1, 
	       ( @_ && 'HASH' eq ref($_[-1]) ? %{pop @_} : () ) );

  # store the row data in what the caller wants, or the object's buffer.
  my $row = shift || $self->{row_arr};

  # guess what? there's (possibly only sometimes) an extra row filled
  # with indefs at the end of the file! so we can't actually use
  # the end of file condition to stop reading.  ACKCKCKCCKKC!
  return undef if $self->{row} == $self->{nrows};


  my $nread = read( $self->{fh}, $self->{buf}, $self->{row_len});

  unless( $nread == $self->{row_len} )
  {
    # if it's not zero, then we've read too little, and that's a no-no
    croak( "incomplete last record (", $self->{row}+1, ")\n" )
      if 0 != $nread;

    # EOF
    return undef;
  }

  # if we're not splitting vectors up, just read into the final destination
  my $data = $attr{VecSplit} ? $self->{data} : $row;

  # pre-extend.  should only hurt once
  $#{$data} = $self->{row_els};
  @{$data} = unpack( $self->{row_extract}, $self->{buf} );

  if ( $attr{VecSplit} )
  {
    # this is slow, but it works. clean it up someday

    # prextend the row.  should only hurt once.
    $#{$row} = $self->{cols}->ncols;
    @$row = ();
    for my $col ( $self->{cols}->cols )
    {
      if ( $col->nelem == 1 )
      {
	my $elem = shift @$data;
	push @$row, $col->is_indef($elem) ? undef : $elem;
      }
      else
      {
	push @$row, 
	[ map { $col->is_indef($_) ? undef : $_ } 
	  splice( @$data, 0, $col->nelem ) ];
      }
    }
  }
  else
  {
    my $idx = 0;
    for my $col ( $self->{cols}->cols )
    {
      for ( my $nelem = $col->nelem; $nelem ; $nelem--, $idx++ )
      {
	$data->[$idx] = undef if $col->is_indef($data->[$idx]);
      }
    }
  }

  $self->{row}++;
  return $row;