view release on metacpan or  search on metacpan

lib/FlatFile/DataStore.pm  view on Meta::CPAN

    my $fh;
    sysopen( $fh, $file, O_RDONLY|O_CREAT )
                         or croak qq/Can't open $file for read: $!/;
    flock $fh, LOCK_SH   or croak qq/Can't lock $file shared: $!/;
    binmode $fh;

    return $fh;
}

#---------------------------------------------------------------------
# 
# =head2 locked_for_write()
# 
# Takes a file name, opens it for read/write, locks it, sets binmode,
# and returns the open file handle.
# 
# Private method.
# 
# =cut
# 

sub locked_for_write {
    my( $self, $file ) = @_;
    untaint path => $file;

    my $fh;
    sysopen( $fh, $file, O_RDWR|O_CREAT ) or croak qq/Can't open $file for read-write: $!/;
    my $ofh = select( $fh ); $| = 1; select ( $ofh );  # flush buffers
    flock $fh, LOCK_EX                    or croak qq/Can't lock $file exclusive: $!/;
    binmode $fh;

    return $fh;
}

#---------------------------------------------------------------------
# 
# =head2 read_record()
# 
# Takes an open file handle and a seek position and
# 
#     - seeks there to read the preamble
#     - seeks to the record data and reads that
#     - returns a record object created from the preamble and data
# 
# Private method.
# 
# =cut
# 

sub read_record {
    my( $self, $fh, $seekpos ) = @_;

    # we don't call read_preamble() because we need len anyway
    my $len  = $self->preamblelen;
    my $sref = $self->read_bytes( $fh, $seekpos, $len ); 
    my $preamble = $self->new_preamble( { string => $$sref } );

    $seekpos    += $len;
    $len         = $preamble->reclen;
    my $recdata  = $self->read_bytes( $fh, $seekpos, $len ); 

    my $record = $self->new_record( {
        preamble => $preamble,
        data     => $recdata,  # scalar ref
        } );

    return $record;
}

#---------------------------------------------------------------------
# 
# =head2 read_preamble()
# 
# Takes an open file handle (probably the key file) and a seek
# position and
# 
#     - seeks there to read the preamble
#     - returns the preamble string (not an object)
# 
# Private method.
# 
# =cut
# 

sub read_preamble {
    my( $self, $fh, $seekpos ) = @_;

    my $len  = $self->preamblelen;
    my $sref = $self->read_bytes( $fh, $seekpos, $len ); 

    return $$sref;  # want the string, not the ref
}

#---------------------------------------------------------------------
# 
# =head2 read_bytes()
# 
# Takes an open file handle, a seek position and a length, reads
# that many bytes from that position, and returns a scalar
# reference to that data.  It is expected that the file is set
# to binmode.
# 
# Private method.
# 
# =cut
# 

sub read_bytes {
    my( $self, $fh, $seekpos, $len ) = @_;

    my $string;
    sysseek $fh, $seekpos, 0 or croak qq/Can't seek: $!/;
    my $rc = sysread $fh, $string, $len;
    croak qq/Can't read: $!/ unless defined $rc;

    return \$string;
}

#---------------------------------------------------------------------
# 
# =head2 write_bytes()
# 
# Takes an open file handle, a seek position, and a scalar
# reference and writes that data to the file at that position.