view release on metacpan or  search on metacpan

lib/BDB/Wrapper.pm  view on Meta::CPAN

      if($dbh && $dbh->db_put('name', 'value')==0){
      }
      else{
        $lock->cds_unlock();
        $dbh->db_close() if $dbh;
        die 'Failed to put to '.$self->{'bdb'};
      }
      $lock->cds_unlock();
      $dbh->db_close() if $dbh;
    }

    if(my $dbh=$self->{'bdbw'}->create_read_dbh($self->{'bdb'})){
      my $value;
      if($dbh->db_get('name', $value)==0){
        print 'Name='.$name.' value='.$value."\n";
      }
      $dbh->db_close();
    }
  }

=cut

=head1 Example of using transaction

=cut

=pod

  # Transaction Usage
  #!/usr/bin/perl -w
  package bdb_write;
  use strict;
  use BDB::Wrapper;

  my $pro = new bdb_write;
  $pro->run();
  sub new(){
    my $self={};
    return bless $self;
  }

  sub run(){
    my $self=shift;
    $self->{'bdbw'}=new BDB::Wrapper;
    my ($dbh, $env)=$self->{'bdbw'}->create_write_dbh({'bdb'=>'/tmp/bdb_write.bdb', 'txn'=>1});
    my $txn = $env->txn_begin(undef, DB_TXN_NOWAIT);
  
    my $cnt=0;
    for($i=0;$i<1000;$i++){
      $dbh->db_put($i, $i*rand());
      $cnt=$i;
      if($cnt && $cnt%100==0){
        $txn->txn_commit();
        $txn = $env->txn_begin(undef, DB_TXN_NOWAIT);
      }
    }

    $txn->txn_commit();
    $env->txn_checkpoint(1,1,0);
    $dbh->db_close();
    chmod 0666, '/tmp/bdb_write.bdb';
    print "Content-type:text/html\n\n";
    print $cnt."\n";
  }

=cut

=head1 methods

=head2 new

  Creates an object of BDB::Wrapper
  
  If you set {'ram'=>1}, you can use /dev/shm/bdb_home for storing locking file for BDB instead of /tmp/bdbwrapper/bdb_home/.
  1 is default value.
  
  If you set {'no_lock'=>1}, the control of concurrent access will not be used. So the lock files are also not created.
  0 is default value.
  
  If you set {'cache'=>$CACHE_SIZE}, you can allocate cache memory of the specified bytes for using bdb files.
  The value can be overwritten by the cache value of create_write_dbh
  undef is default value.
  
  If you set {'wait'=>wait_seconds}, you can specify the seconds in which dead lock will be removed.
  22 is default value.
  
  If you set {'transaction'=>transaction_root_dir}, all dbh object will be created in transaction mode unless you don\'t specify transaction root dir in each method.
  0 is default value.

=cut

sub new(){
  my $self={};
  my $class=shift;
  my $op_ref=shift;
  $self->{'lock_root'}='/tmp/bdbwrapper';
  $self->{'no_lock'}=0;
  $self->{'Flags'}='';
  $self->{'wait'}= 22;
  $self->{'default_txn_dir'}=$self->{'lock_root'}.'/txn_data';
  while(my ($key, $value)=each %{$op_ref}){
    if($key eq 'ram'){
      if($value){
        $self->{'lock_root'}='/dev/shm';
      }
    }
    elsif($key eq 'cache'){
      $self->{'Cachesize'}=$value if(defined($value));
    }
    elsif($key eq 'Cachesize'){
      $self->{'Cachesize'}=$value if(defined($value));
    }
    elsif($key eq 'no_lock'){
      if($value){
        $self->{'no_lock'}++;
      }
    }
    elsif($key eq 'wait'){
      $self->{'wait'}=$value;
    }
    elsif($key eq 'transaction'){

lib/BDB/Wrapper.pm  view on Meta::CPAN

      -Compare => $sort_code_ref;
    }
    else{
      tie %hash, $type,
      -Env=>$env,
      -Filename => $bdb,
      -Flags    => DB_RDONLY;
    }
    alarm(0);
  };
  
  unless($dont_try){
    if($@){
      if($@ =~ /timeout/){
        $op->{'dont_try'}=1;
        $dont_try=1;
        my $home_dir=$self->get_bdb_home({'bdb'=>$bdb, 'transaction'=>$transaction});
        system('rm -rf '.$home_dir) if($home_dir=~ m!^(?:/tmp/bdbwrapper|/dev/shm)!);
        if(ref($op) eq 'HASH'){
          return $self->create_read_hash_ref($bdb, $op);
        }
        else{
          return $self->create_read_hash_ref($bdb, $hash, $dont_try, $sort_code_ref);
        }
      }
      else{
        alarm(0);
      }
    }
  }
  return \%hash;
}

=head2 rmkdir

  Code from CGI::Accessup.
  This creates the specified directory recursively.

  rmkdir($dir);

=cut
sub rmkdir(){
  my $self=shift;
  my $path=shift;
  my $force=shift;
  if($path){
    $path=~ s!^\s+|\s+$!!gs;
    if($path=~ m![^/\.]!){
      my $target='';
      if($path=~ s!^([\./]+)!!){
        $target=$1;
      }
      while($path=~ s!^([^/]+)/?!!){
        $target.=$1;
        if($force && -f $target){
          unlink $target;
        }
        unless(-d $target){
          mkdir($target,0777) || Carp::carp("Failed to create ".$target);
          # for avoiding umask to mkdir
          chmod 0777, $target || Carp::carp("Failed to chmod ".$target);;
        }
        $target.='/';
      }
      return 1;
    }
  }
  return 0;
}


=head2 get_bdb_home

  This will return bdb_home.
  You may need the information for recovery and so on.

  get bdb_home({
    'bdb'=>$bdb,
    'transaction'=>$transaction
    });

  OR

  get_bdb_home($bdb);

=cut

sub clear_bdb_home(){
  my $self = shift;
  my $op = shift;
  my $bdb = $op->{'bdb'};
  my $home_dir=$self->get_bdb_home({'bdb'=>$bdb});
  # Prevent OS command injection
}

sub get_bdb_home(){
  my $self=shift;
  my $op=shift;
  my $bdb='';
  my $transaction=undef;
  my $lock_root=$self->{'lock_root'};
  if($op && ref($op) eq 'HASH'){
    $bdb=$op->{'bdb'} || return;
    if(exists($op->{'transaction'})){
      $transaction=$op->{'transaction'};
    }
    elsif(exists($op->{'txn'})){
      $transaction=$op->{'txn'};
    }
    else{
      $transaction=$self->{'transaction'};
    }
  }
  else{
    $bdb=File::Spec->rel2abs($op) || return;
    $transaction=$self->{'transaction'};
  }
  if($transaction && $transaction!~ m!^/.!){
    $transaction = $self->{'default_txn_dir'};
  }
  if($transaction){