#!/usr/bin/perl -- use strict; use warnings; use File::Temp (); use DB_File; Main( @ARGV ); exit( 0 ); sub Main { Shabba(); my $temp = File::Temp->new()->filename; my $btnf = DB_File::BTREEINFO->new; $btnf ->{'flags'} = R_DUP; HitAndQuit( $temp, $btnf , qw[ 1 2 1 4 ] ); HitAndQuit( $temp, $btnf , qw[ 2 6 2 8 ] ); HitAndQuit( $temp, $btnf , qw[ b o b s ] ); unlink $temp or die "unlink $temp: $!"; } sub HitAndQuit { my( $temp, $BTREEINFO , @rest ) = @_; #~ my $tree = tie my(%foo), 'DB_File', $temp, O_RDWR|O_CREAT, 0666, $BTREEINFO or die "Cannot tie ($temp): $!"; for( my $ix = 0; $ix < @rest ; $ix+=2 ){ $foo{ $rest[ $ix] } = $rest[ $ix+1 ]; } DDUP( tied %foo ); #~ untie $tree; } sub DDUP { my ( $x ) = @_; for ( my $st = $x->seq( my( $key, $value), R_FIRST ) ; $st == 0 ; $st = $x->seq( $key, $value, R_NEXT ) ) { print "{ $key }{ $value } "; } print "\n"; } sub Shabba { print <<"SHABBA"; ### $] #~ \$DB_File::db_ver $DB_File::db_ver #~ \$DB_File::db_version $DB_File::db_version #~ \$DB_File::VERSION $DB_File::VERSION ######## SHABBA } __END__ ### 5.014001 #~ $DB_File::db_ver 5.001025 #~ $DB_File::db_version 5.1 #~ $DB_File::VERSION 1.824 ######## { 1 }{ 2 } { 1 }{ 4 } { 1 }{ 2 } { 1 }{ 4 } { 2 }{ 6 } { 2 }{ 8 } { 1 }{ 2 } { 1 }{ 4 } { 2 }{ 6 } { 2 }{ 8 } { b }{ o } { b }{ s }