view release on metacpan or  search on metacpan

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

  elsif(exists($op->{'txn'})){
    $transaction = $op->{'txn'};
  }
  else{
    $transaction = $self->{'transaction'};
  }

  if($transaction && $transaction!~ m!^/.!){
    $transaction = $self->{'default_txn_dir'};
  }
  
  my $bdb_dir=$bdb;
  $bdb_dir=~ s!/[^/]+$!!;
  local $SIG{ALRM} = sub { die "timeout"};
  my %hash;
  eval{
    alarm($self->{'wait'});
    $self->rmkdir($bdb_dir);
    if($sort_code_ref && !$hash){
      tie %hash, $type,
      -Env=>$env,
      -Filename => $bdb,
      -Mode => 0666,
      -Flags    => DB_CREATE,
      -Compare => $sort_code_ref;
    }
    else{
      tie %hash, $type,
      -Env=>$env,
      -Filename => $bdb,
      -Mode => 0666,
      -Flags    => DB_CREATE;
    }
    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_write_hash_ref($bdb, $op);
        }
        else{
          return $self->create_write_hash_ref($bdb, $hash, $dont_try, $sort_code_ref);
        }
      }
      else{
        alarm(0);
      }
    }
  }
  return \%hash;
}

=head2 create_read_hash_ref

  Not recommended method. Please use create_read_dbh and cursor().
  This will creates database handler for reading.

  $self->create_read_hash_ref({
    'bdb'=>$bdb,
    'hash'=>0 or 1,
    'dont_try'=>0 or 1,
    'sort_code_ref'=>$sort_code_reference,
    'sort' or 'sort_num'=>0 or 1,
    'reverse_cmp'=>0 or 1,
    'reverse' or 'reverse_num'=>0 or 1
    });

  In the default mode, BDB file will be created as Btree.

  If you set 'hash' 1, Hash BDB will be created.

  If you set 'dont_try' 1, this module won\'t try to unlock BDB if it detects the situation in which deadlock may be occuring.

  If you set sort_code_ref some code reference, you can set subroutine for sorting for Btree.

  If you set sort or sort_num 1, you can use sub {$_[0] <=> $_[1]} for sort_code_ref.

  If you set reverse or reverse_num 1, you can use sub {$_[1] <=> $_[0]} for sort_code_ref.

  If you set reverse_cmp 1, you can use sub {$_[1] cmp $_[0]} for sort_code_ref.

  If you set use_env 1, you can use environment for this method.

=cut

sub create_read_hash_ref(){
  my $self=shift;
  my $bdb=shift;
  my $op='';
  if($bdb && ref($bdb) eq 'HASH'){
    $op=$bdb;
    $bdb=$op->{'bdb'};
  }
  else{
    $op=shift;
  }
  $bdb=File::Spec->rel2abs($bdb);
  
  my $hash=0;
  my $dont_try=0;
  my $sort_code_ref=undef;
  if(ref($op) eq 'HASH'){
    $hash=$op->{'hash'} || 0;
    $dont_try=$op->{'dont_try'} || 0;
    if($op->{'reverse'} || $op->{'reverse_num'}){
      $sort_code_ref=sub {$_[1] <=> $_[0]};
    }
    elsif($op->{'reverse_cmp'}){
      $sort_code_ref=sub {$_[1] cmp $_[0]};
    }
    elsif($op->{'sort'} || $op->{'sort_num'}){
      $sort_code_ref=sub {$_[0] <=> $_[1]};
    }
    else{
      $sort_code_ref=$op->{'sort_code_ref'};