/usr/local/CPAN/POEIKC/DBMedit.pm

• package DBMedit
  • dbmopen
  • dbmclose
  • path
  • name
  • keys
  • del
  • get
  • like
  • gets
  • count
  • counts
  • copy
  • copys
• EOF

package DBMedit;


my $end = sub {
	#warn('--END--');
	for my $name(keys %{$DBM}){
		dbmclose(%{$DBM->{$name}}) if %{$DBM->{$name}}; 
	}
	die @_ if @_; 
};
$SIG{INT} = $end;
END {$end->();}

my $DBM     = {};
my $db_path = {}; # name=>path
my $name;


sub dbmopen {
	
	@_ == 2 or return 'parameter error .. dbmopen($name, $dbm_file_fullpath) ';
	
	$name = shift ;
	$db_path->{$name} = shift;
	
	return dbmopen(%{$DBM->{$name}}, $db_path->{$name}, 0666) || join "\t"=>( $! ,$name, $db_path->{$name} , __LINE__);
	#return scalar keys %{$DBM->{$name}};
}

sub dbmclose {
	$name = shift if @_;
#	if (%{$DBM->{$name}}) {
		delete $db_path->{$name};
		dbmclose(%{$DBM->{$name}}) ; 
		undef $name;
#	}
}

sub path { return $db_path }
sub name { $name = shift || return $name}

sub keys {
	#@_ or return 'parameter error .. keys($offset, $length) count=>'. &count();
	my ($offset, $length ) = @_;
	$offset ||= 0; 
	$length ||= 9;
	return (keys %{$DBM->{$name}})[$offset .. $length];
}


sub del {
	my $key = shift;
	return delete $DBM->{$name}->{$key};
}

sub get {
	my $key = shift;
	return $DBM->{$name}->{$key};
}

sub like {
	my $key = shift;
	$key = qr/$key/;
	my @list;
	for (keys %{$DBM->{$name}}) {
		/$key/ and push @list, $_;
	}
	return @list
}

sub gets {
	#my ($offset, $length ) = @_;
	my %h;
	%h = map {$_=>$DBM->{$_[2] || $name}->{$_}} &keys(@_);
	return \%h;
}

sub count {return scalar keys %{$DBM->{$name}};}
sub counts {
	my $h;
	for my $name(keys %{$DBM}){
		$h->{$name} = scalar keys %{$DBM->{$name}};
	}
	return $h;
}

sub copy {
	my ($name1, $name2, $key) = @_;
	$DBM->{$name2}->{$key} = $DBM->{$name1}->{$key};
}

sub copys {
	my ($name1, $name2, $offset, $length ) = @_;
	for my $key( (keys %{$DBM->{$name1}})[$offset .. $length]) {
		$DBM->{$name2}->{$key} = $DBM->{$name1}->{$key};
	}
}

1;