view release on metacpan or  search on metacpan

lib/DBM/Deep/Storage/File.pm  view on Meta::CPAN

    my $self = shift;

    return 0 unless $self->{fh};
    return( (-s $self->{fh}) - $self->{file_offset} );
}

=head2 set_inode()

This will set the inode value of the underlying file object.

This is only needed to handle some obscure Win32 bugs. It really shouldn't be
needed outside this object.

There is no return value.

=cut

sub set_inode {
    my $self = shift;

    unless ( defined $self->{inode} ) {
        my @stats = stat($self->{fh});
        $self->{inode} = $stats[1];
        $self->{end} = $stats[7];
    }

    return 1;
}

=head2 print_at( $offset, @data )

This takes an offset and some data to print.

C< $offset > will be used to seek into the file. If file_offset is
set, it will be used as the zero location. If it is undefined, no seeking will
occur. Then, C< @data > will be printed to the current location.

There is no return value.

If writing to the file would make the file too big for the C<pack_size> that
is a fatal error.

=cut

sub print_at {
    my $self = shift;
    my $loc  = shift;

    local ($,,$\);

    my $fh = $self->{fh};
    my $len = length( join '', @_ );

    seek( $fh, $loc + $self->{file_offset}, SEEK_SET );

    if(tell($fh) > $len + 2 ** (8 * $self->{byte_size}) - 1) {
        die("DBM::Deep: too much data, try a bigger pack_size\n");
    }

    if ( DEBUG ) {
        my $caller = join ':', (caller)[0,2];
        warn "($caller) print_at( " . (defined $loc ? $loc : '<undef>') . ", $len )\n";
    }

    print( $fh @_ ) or die "Internal Error (print_at($loc)): $!\n";

    return 1;
}

=head2 read_at( $offset, $length )

This takes an optional offset and a length.

C< $offset >, if defined, will be used to seek into the file. If file_offset is
set, it will be used as the zero location. If it is undefined, no seeking will
occur. Then, C< $length > bytes will be read from the current location.

The data read will be returned.

=cut

sub read_at {
    my $self = shift;
    my ($loc, $size) = @_;

    my $fh = $self->{fh};
    if ( defined $loc ) {
        seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
    }

    if ( DEBUG ) {
        my $caller = join ':', (caller)[0,2];
        warn "($caller) read_at( " . (defined $loc ? $loc : '<undef>') . ", $size )\n";
    }

    my $buffer;
    read( $fh, $buffer, $size);

    return $buffer;
}

=head2 DESTROY

When the ::Storage::File object goes out of scope, it will be closed.

=cut

sub DESTROY {
    my $self = shift;
    return unless $self;

    $self->close;

    return;
}

=head2 request_space( $size )

This takes a size and adds that much space to the DBM.

This returns the offset for the new location.

=cut

sub request_space {
    my $self = shift;
    my ($size) = @_;

    #XXX Do I need to reset $self->{end} here? I need a testcase
    my $loc = $self->{end};
    $self->{end} += $size;

    return $loc;
}

=head2 copy_stats( $target_filename )

This will take the stats for the current filehandle and apply them to
C< $target_filename >. The stats copied are:

=over 4

=item * Onwer UID and GID

=item * Permissions

=back

=cut

sub copy_stats {
    my $self = shift;