view release on metacpan or  search on metacpan

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

}

=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;
    my ($temp_filename) = @_;

    my @stats = stat( $self->{fh} );
    my $perms = $stats[2] & 07777;
    my $uid = $stats[4];
    my $gid = $stats[5];
    chown( $uid, $gid, $temp_filename );
    chmod( $perms, $temp_filename );
}

sub flush {
    my $self = shift;

    # Flush the filehandle
    my $old_fh = select $self->{fh};
    my $old_af = $|; $| = 1; $| = $old_af;
    select $old_fh;

    return 1;
}

sub is_writable {
    my $self = shift;

    my $fh = $self->{fh};
    return unless defined $fh;
    return unless defined fileno $fh;
    local $\ = '';  # just in case
    no warnings;    # temporarily disable warnings
    local $^W;      # temporarily disable warnings
    return print $fh '';
}

sub lock_exclusive {
    my $self = shift;
    my ($obj) = @_;
    return $self->_lock( $obj, LOCK_EX );
}

sub lock_shared {
    my $self = shift;
    my ($obj) = @_;
    return $self->_lock( $obj, LOCK_SH );
}

sub _lock {
    my $self = shift;
    my ($obj, $type) = @_;

    $type = LOCK_EX unless defined $type;

    #XXX This is a temporary fix for Win32 and autovivification. It
    # needs to improve somehow. -RobK, 2008-03-09
    if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
        $type = LOCK_EX;
    }

    if (!defined($self->{fh})) { return; }

    #XXX This either needs to allow for upgrading a shared lock to an
    # exclusive lock or something else with autovivification.
    # -RobK, 2008-03-09
    if ($self->{locking}) {
        if (!$self->{locked}) {
            flock($self->{fh}, $type);

            # refresh end counter in case file has changed size
            my @stats = stat($self->{fh});