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
  30         transaction_id     => 0,
  31     }, $class;
  32
  33     # Grab the parameters we want to use
  34     foreach my $param ( keys %$self ) {
  35         next unless exists $args->{$param};
  36         $self->{$param} = $args->{$param};
  37     }
  38
  39     if ( $self->{fh} && !$self->{file_offset} ) {
  40         $self->{file_offset} = tell( $self->{fh} );
  41     }
  42
  43     $self->open unless $self->{fh};
  44
  45     return $self;
  46 }
  47
  48 sub open {
  49     my $self = shift;
  50
  51     # Adding O_BINARY does remove the need for the binmode below. However,
  52     # I'm not going to remove it because I don't have the Win32 chops to be
  53     # absolutely certain everything will be ok.
  54     my $flags = O_RDWR | O_CREAT | O_BINARY;
  55
  56     my $fh;
  57     sysopen( $fh, $self->{file}, $flags )
  58         or die "DBM::Deep: Cannot sysopen file '$self->{file}': $!\n";
  59     $self->{fh} = $fh;
  60
  61     # Even though we use O_BINARY, better be safe than sorry.
  62     binmode $fh;
  63
  64     if ($self->{autoflush}) {
  65         my $old = select $fh;
  66         $|=1;
  67         select $old;
  68     }
  69
  70     return 1;
  71 }
  72
  73 sub close {
  74     my $self = shift;
  75
  76     if ( $self->{fh} ) {
  77         close $self->{fh};
  78         $self->{fh} = undef;
  79     }
  80
  81     return 1;
  82 }
  83
  84 sub DESTROY {
  85     my $self = shift;
  86     return unless $self;
  87
  88     $self->close;
  89
  90     return;
  91 }
  92
  93 sub begin_transaction {
  94     my $self = shift;
  95
  96     $self->{transaction_id}++;
  97 }
  98
  99 sub end_transaction {
 100     my $self = shift;
 101
 102     $self->{transaction_id} = 0;
 103 }
 104
 105 sub transaction_id {
 106     my $self = shift;
 107
 108     return $self->{transaction_id};
 109 }
 110
 111 #sub commit {
 112 #}
 113
 114 1;
 115 __END__
 116