view release on metacpan or  search on metacpan

lib/Fsdb/IO.pm  view on Meta::CPAN

    my @self_cols = @{$self->{_cols}};
    my @other_cols = @{$other->{_cols}};
    return "compatible" if ($#self_cols != $#other_cols);
    foreach (0..$#self_cols) {
	return "compatible" if ($self_cols[$_] ne $other_cols[$_]);
    };
    return 'identical';
}

=head2 close

    $fsdb->close;

Closes the file, frees open file handle, or sends an EOF signal
(and undef) down the open queue.

=cut

sub close {
    my($self) = @_;
    return if ($self->{_error});
    if (defined($self->{_fh})) {
        $self->{_fh}->close;
	delete $self->{_fh};   # help garbage collect auto-generated Symbols from IO::Handle
    };
    if (defined($self->{_queue})) {
	$self->{_queue}->enqueue(undef);
	delete $self->{_queue};
    };
    # reap any subprocesses
    if (defined($self->{_hdfs_reader_pid})) {
            waitpid $self->{_hdfs_reader_pid}, 0;
    };
    if (defined($self->{_compression_pid})) {
            waitpid $self->{_compression_pid}, 0;
    };
    $self->{_error} = 'closed';
}

=head2 error

    $fsdb->error;

Returns a descriptive string if there is an error,
or undef if not.

The string will never end in a newline or punctuation.

=cut

sub error {
    my($self) = @_;
    return $self->{_error};
}

=head2 update_v1_headerrow

internal: create the header the internal schema

=cut
sub update_v1_headerrow {
    my $self = shift @_;
    my $h = "#h ";
    $h = "#L " if ($self->{_rscode} ne 'D');
    if ($self->{_fscode} && $self->{_fscode} ne 'D') {
	$h .= "-F" . $self->{_fscode} . " ";
    };
    if ($self->{_rscode} && $self->{_rscode} eq 'I') {  # xxx: should be ne 'D'
	$h .= "-R" . $self->{_rscode} . " ";
    };
    $h .= join(" ", @{$self->{_cols}});
    $self->{_headerrow} = $h;
}


=head2 parse_v1_headerrow

internal: interpet the header

=cut
sub parse_v1_headerrow ($) {
    my($self) = @_;
    return if ($self->{_error});
    my(@f) = split(/\s+/, $self->{_headerrow});
    my $tag = shift @f;
    if ($tag eq '#L') {
	$self->{_rscode} = 'C';
    } elsif ($tag ne "#h") {
        $self->{_error} = "header line is not fsdb format";
	return;
   };
   #
   # handle options
   #
   while ($#f >= 0 && $f[0] =~ /^-(.)(.*)/) {
       my($key, $value) = ($1, $2);
       shift @f;
       if ($key eq 'F') {
	   $self->parse_v1_fscode($value);
        }
    };

    # create them!
    foreach (@f) {
	$self->_internal_col_create($_);
    };
}

=head2 update_headerrow

internal: create the header the internal schema

=cut
sub update_headerrow($) {
    my $self = shift @_;
    my $h = "#fsdb ";
    if ($self->{_fscode} && $self->{_fscode} ne 'D') {
	$h .= "-F " . $self->{_fscode} . " ";
    };
    if ($self->{_rscode} && $self->{_rscode} ne 'D') {  # xxx: should be ne 'D'
	$h .= "-R " . $self->{_rscode} . " ";
    };
    if ($self->{_compression} && $self->{_compression} ne 'none') {  # xxx: should be ne 'D'
	$h .= "-Z " . $self->{_compression} . " ";
    };
    $self->{_header_prequel} = $h;   # save this aside for dbcolneaten
    $h .= join(" ", $self->colspecs());
    $self->{_headerrow} = $h;
}


=head2 parse_headerrow

internal: interpet the v2 header.
Format is:

    #fsdb [-F x] [-R x] [-Z x] columns

All options must come first, start with dashes, and have an argument.
(More regular than the v1 header.)

Columns have optional :t type specifiers.

=cut
sub parse_headerrow($) {
    my($self) = @_;
    return if ($self->{_error});
    my(@f) = split(/\s+/, $self->{_headerrow});
    my $tag = shift @f;
    if ($tag eq '#fsdb') {
	# fall through
    } elsif ($tag eq '#L' || $tag eq '#h') {
	return $self->parse_v1_headerrow;
    } else {
        $self->{_error} = "header line is not fsdb format";
	return;
    };

    #
    # handle options
    #
    while ($#f >= 0 && $f[0] =~ /^-/) {
        my($key) = shift @f;
        my($value) = shift @f;
        if ($key eq '-F') {
	    $self->parse_fscode($value);
        } elsif ($key eq '-R') {
	    $self->parse_rscode($value);
        } elsif ($key eq '-Z') {
	    $self->parse_compression($value);
	} else {
	    $self->{_error} = "header has unknown option " . $key;
	    return;
	};