view release on metacpan or  search on metacpan

lib/Data/SeaBASS.pm  view on Meta::CPAN

				}
				if (wantarray) {
					return %{$data_row};
				} else {
					return $data_row;
				}
			} ## end if ($line)
		} ## end while (my $line = <$handle>)
	} ## end elsif ($self->{'handle'})
	return;
} ## end sub next

=head2 rewind()

C<rewind> seeks to the start of the data.  The next C<next> will return the 
very first row (or C<data(0)>).  If caching is enabled, it will not actually
perform a seek, it will merely reset the index interator.  If caching is
disabled, a seek is performed on the file handle to return to the start of the
data.

=cut

sub rewind {
	my ($self) = @_;
	if ( $self->{'dataidx'} != -1 ) {
		if ( !$self->{'options'}{'cache'} ) {
			seek( $self->{'handle'}, $self->{'data_start_position'}, SEEK_SET );
		}
		$self->{'line_number'} = $self->{'data_start_line'};
		$self->{'dataidx'}     = -1;
	} ## end if ($self->{'dataidx'}...)
} ## end sub rewind

=head2 update(\%data_row | \@data_row | $data_row | %data_row)

    while (my %row = $sb_file->next()){
        if ($row{'depth'} == -999){
            $row{'depth'} = 0;
        }
        $sb_file->update(\%row);
    }
    
    # Less useful for update():
    print join(',',@{$sb_file->actual_fields()}); #lat,lon,depth,chl
    
    while (my %row = $sb_file->next()){
        if ($row{'depth'} == -999){
            $row{'depth'} = 0;
        }
        $sb_file->update(@row{'lat','lon','depth','chl'});
        # or
        $sb_file->update([@row{'lat','lon','depth','chl'}]);
    }

C<update> replaces the last row read (using C<next()>) with the input.

Caching must be enabled to use C<update>, C<set>, or C<insert>.

=cut

sub update {
	my $self = shift;
	if ( !$self->{'options'}{'cache'} ) {
		croak("Caching must be enabled to write.");
	} elsif ( $self->{'dataidx'} == -1 ) {
		croak("No rows read yet.");
	}
	my $new_row = $self->ingest_row(@_);
	unless ( defined($new_row) ) {
		croak("Error parsing inputs");
	}
	$self->{'data'}[ $self->{'dataidx'} ] = $new_row;
} ## end sub update

=head2 set($index, \%data_row | \@data_row | $data_row | %data_row)

    my %row = (lat => 1, lon => 2, chl => 1);
    $sb_file->set(0, \%row);
    
    print join(',',@{$sb_file->actual_fields()}); #lat,lon,chl
    $sb_file->set(0, [1, 2, 1]);
    

C<set> replaces the row  at the given index with the input.  Seeks to the 
given index if it has not been read to yet.  C<croak>s if the file does not go
up to the index specified.

Caching must be enabled to use C<update>, C<set>, or C<insert>.

=cut

sub set {
	my $self  = shift;
	my $index = shift;
	if ( !$self->{'options'}{'cache'} ) {
		croak("Caching must be enabled to write");
	}
	if ( $index < 0 ) {
		croak("Index must be positive integer");
	}
	my $new_row = $self->ingest_row(@_);
	unless ( defined($new_row) ) {
		croak("Error parsing inputs");
	}

	if ( $index > $self->{'max_dataidx'} ) {
		my $current_idx = $self->{'dataidx'};
		$self->data($index);
		$self->{'dataidx'} = $current_idx;

		if ( $index > $self->{'max_dataidx'} ) {
			croak("Index out of bounds.");
		}
	} ## end if ($index > $self->{'max_dataidx'...})

	$self->{'data'}[$index] = $new_row;
} ## end sub set

=head2 insert($index, \%data_row | \@data_row | $data_row | %data_row)

    use Data::SeaBASS qw(INSERT_BEGINNING INSERT_END);
    ...
    
    my %row = (lat => 1, lon => 2, chl => 1);
    $sb_file->insert(INSERT_BEGINNING, \%row);
    
    print join(',',@{$sb_file->actual_fields()}); #lat,lon,chl
    
    $sb_file->insert(1, [1, 2, 1]);
    $sb_file->insert(INSERT_END, [1, 2, 1]);
    
Inserts the row into the given position.  C<INSERT_BEGINNING> inserts a new row
at the start of the data, C<INSERT_END> inserts one at the end of the data

lib/Data/SeaBASS.pm  view on Meta::CPAN

		unless ( $self->set_delim( $strict, $v ) ) {
			if ($strict) {
				$success = 0;
			}
		}
	} elsif ( $k =~ m"^/?missing$" ) {
		$self->{'missing'} = ( length($v) ? $v : $DEFAULT_MISSING );
		$self->{'missing_is_number'} = looks_like_number( $self->{'missing'} );
	} elsif ( $k =~ m"^/?above_detection_limit" ) {
		$self->{'above_detection_limit'} = ( length($v) ? $v : $self->{'missing'} );
		$self->{'adl_is_number'} = looks_like_number( $self->{'above_detection_limit'} );
	} elsif ( $k =~ m"^/?below_detection_limit" ) {
		$self->{'below_detection_limit'} = ( length($v) ? $v : $self->{'missing'} );
		$self->{'bdl_is_number'} = looks_like_number( $self->{'below_detection_limit'} );
	}

	$_[1] = $k;
	$_[2] = $v;

	return $success;
} ## end sub validate_header

=head2 set_delim($strict, $delim)

Takes a string declaring the delim (IE: 'comma', 'space', etc) and updates the
object's internal delimiter regex.

=cut

sub set_delim {
	my $self   = shift;
	my $strict = shift;
	my $delim  = shift || '';
	if ( $delim eq 'comma' ) {
		$delim = qr/\s*,\s*/;
	} elsif ( $delim eq 'semicolon' ) {
		$delim = qr/\s*;\s*/;
	} elsif ( $delim eq 'space' ) {
		$delim = qr/\s+/;
	} elsif ( $delim eq 'tab' ) {
		$delim = qr/\t/;
	} elsif ($strict) {
		carp("delimiter not understood");
	} else {
		my $slash = ( $self->{'options'}{'keep_slashes'} ? '/' : '' );
		$self->{'headers'}{"${slash}delimiter"} = 'comma';
		$delim = undef;
	}
	$self->{'delim'} = $delim;
	return ( $delim ? 1 : 0 );
} ## end sub set_delim

=head2 update_fields()

C<update_fields> runs through the currently cached rows and calls 
C<add_and_remove_fields> on each row.  It then updates the /fields and /units
headers in the header hash.

=cut

sub update_fields {
	my ($self) = @_;
	if ( $self->{'options'}{'cache'} && $self->{'max_dataidx'} >= 0 ) {
		foreach my $hash ( @{ $self->{'data'} } ) {
			$self->add_and_remove_fields($hash);
		}
	}

	my $slash = ( $self->{'options'}{'keep_slashes'} ? '/' : '' );
	$self->{'headers'}{"${slash}fields"} = join( ',', @{ $self->{'actual_fields'} } );
	$self->{'headers'}{"${slash}units"}  = join( ',', @{ $self->{'actual_units'} } );
} ## end sub update_fields

=head2 add_and_remove_fields(\%row)

Given a reference to a row, this function deletes any fields removed with
C<remove_field> and adds an undefined or /missing value for each field added
via C<add_field>.  If C<missing_data_to_undef> is set, an undefined value is
given, otherwise, it is filled with the /missing value.

If C<fill_ancillary_data> is set, this function adds missing date, time,
date_time, lat, lon, and depth fields to the retrieved row from the header.

Needlessly returns the hash reference passed in.

=cut

sub add_and_remove_fields {
	my ( $self, $hash ) = @_;
	foreach my $field ( keys(%$hash) ) {
		if ( ( firstidx { $_ eq $field } @{ $self->{'actual_fields'} } ) < 0 ) {
			unless ( $self->{'options'}{'fill_ancillary_data'} && ( firstidx { $_ eq $field } keys( %{ $self->{'ancillary'} } ) ) >= 0 ) {
				delete( $hash->{$field} );
			}
		}
	} ## end foreach my $field (keys(%$hash...))

	my $missing = ( $self->{'options'}{'missing_data_to_undef'} ? undef : $self->{'missing'} );
	while ( my ( $variable, $pad ) = each(%FIELD_FORMATTING) ) {
		my $case_var = $self->{'case_conversion'}{$variable} || $variable;
		my $v = $hash->{$case_var};
		if ($case_var eq 'second'){
			if ( defined($v) && length($v) && (!defined($missing) || $v != $missing)) {
				if ($v =~ /\D/){
					$hash->{$case_var} = sprintf('%02.3f', $v);
				} else {
					$hash->{$case_var} = sprintf('%02d', $v);
				}
			}
		} elsif ( defined($v) && length($v) && (!defined($missing) || $v != $missing)) {
			$hash->{$case_var} = sprintf($pad, $v);
		}
	} ## end while (my ($variable, $pad...))

	if ( defined($self->{'ancillary'}) ) {
		$self->{'ancillary_tmp'} = {};
		for my $variable (@FILL_ANCILLARY_DATA) {
			if ( defined($self->{'ancillary'}{$variable}) ) {
				my $value = $self->extrapolate_variables( $missing, $self->{'ancillary'}{$variable}, $hash );
				if ( defined($value) ) {
					$hash->{$variable} = $value;
				}
			} ## end if ($self->{'ancillary'...})
		} ## end for my $variable (@FILL_ANCILLARY_DATA)
	} ## end if ($self->{'ancillary'...})

	foreach my $field ( @{ $self->{'actual_fields'} } ) {
		if ( !exists( $hash->{$field} ) ) {
			$hash->{$field} = $missing;
		}
	}