lib/DBM/Deep/File.pm

   1 package DBM::Deep::File;
   2
   3 use 5.6.0;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Fcntl qw( :DEFAULT :flock :seek );
   9
  10 our $VERSION = '0.01';
  11
  12 sub new {
  13     my $class = shift;
  14     my ($args) = @_;
  15
  16     my $self = bless {
  17         autobless          => undef,
  18         autoflush          => undef,
  19         end                => 0,
  20         fh                 => undef,
  21         file               => undef,
  22         file_offset        => 0,
  23         locking            => undef,
  24         locked             => 0,
  25         filter_store_key   => undef,
  26         filter_store_value => undef,
  27         filter_fetch_key   => undef,
  28         filter_fetch_value => undef,
  29     }, $class;
  30
  31     # Grab the parameters we want to use
  32     foreach my $param ( keys %$self ) {
  33         next unless exists $args->{$param};
  34         $self->{$param} = $args->{$param};
  35     }
  36
  37     if ( $self->{fh} && !$self->{file_offset} ) {
  38         $self->{file_offset} = tell( $self->{fh} );
  39     }
  40
  41     $self->open unless $self->{fh};
  42
  43     return $self;
  44 }
  45
  46 sub open {
  47     my $self = shift;
  48
  49     # Adding O_BINARY does remove the need for the binmode below. However,
  50     # I'm not going to remove it because I don't have the Win32 chops to be
  51     # absolutely certain everything will be ok.
  52     my $flags = O_RDWR | O_CREAT | O_BINARY;
  53
  54     my $fh;
  55     sysopen( $fh, $self->{file}, $flags )
  56         or die "DBM::Deep: Cannot sysopen file '$self->{file}': $!\n";
  57     $self->{fh} = $fh;
  58
  59     # Even though we use O_BINARY, better be safe than sorry.
  60     binmode $fh;
  61
  62     if ($self->{autoflush}) {
  63         my $old = select $fh;
  64         $|=1;
  65         select $old;
  66     }
  67
  68     return 1;
  69 }
  70
  71 sub close {
  72     my $self = shift;
  73
  74     if ( $self->{fh} ) {
  75         close $self->{fh};
  76         $self->{fh} = undef;
  77     }
  78
  79     return 1;
  80 }
  81
  82 sub DESTROY {
  83     my $self = shift;
  84     return unless $self;
  85
  86     $self->close;
  87
  88     return;
  89 }
  90
  91 1;
  92 __END__
  93