← Back to branch summary

~ken-vandine/+junk/mysql-3.23.58

« back to all changes in this revision

Viewing changes to bdb/perl.BerkeleyDB/t/examples3.t

  • Committer: Ken VanDine
  • Date: 2018-01-27 03:45:15 UTC
  • Revision ID: ken.vandine@canonical.com-20180127034515-wpgsf0e7g0dq3qhv
init

Show diffs side-by-side

added added

removed removed

Lines of Context:
bdb/perl.BerkeleyDB/t/examples3.t
 
1
#!./perl -w
 
2
 
 
3
use strict ; 
 
4
 
 
5
BEGIN {
 
6
    unless(grep /blib/, @INC) {
 
7
        chdir 't' if -d 't';
 
8
        @INC = '../lib' if -d '../lib';
 
9
    }
 
10
}
 
11
 
 
12
use BerkeleyDB; 
 
13
use File::Path qw(rmtree);
 
14
 
 
15
BEGIN 
 
16
{
 
17
    if ($BerkeleyDB::db_version < 3) {
 
18
        print "1..0 # Skipping test, this needs Berkeley DB 3.x or better\n" ;
 
19
        exit 0 ;
 
20
    }
 
21
}
 
22
 
 
23
 
 
24
print "1..2\n";
 
25
 
 
26
my $FA = 0 ;
 
27
 
 
28
{
 
29
    sub try::TIEARRAY { bless [], "try" }
 
30
    sub try::FETCHSIZE { $FA = 1 }
 
31
    $FA = 0 ;
 
32
    my @a ; 
 
33
    tie @a, 'try' ;
 
34
    my $a = @a ;
 
35
}
 
36
 
 
37
{
 
38
    package LexFile ;
 
39
 
 
40
    sub new
 
41
    {
 
42
        my $self = shift ;
 
43
        unlink @_ ;
 
44
        bless [ @_ ], $self ;
 
45
    }
 
46
 
 
47
    sub DESTROY
 
48
    {
 
49
        my $self = shift ;
 
50
        unlink @{ $self } ;
 
51
    }
 
52
}
 
53
 
 
54
 
 
55
sub ok
 
56
{
 
57
    my $no = shift ;
 
58
    my $result = shift ;
 
59
 
 
60
    print "not " unless $result ;
 
61
    print "ok $no\n" ;
 
62
}
 
63
 
 
64
{
 
65
    package Redirect ;
 
66
    use Symbol ;
 
67
 
 
68
    sub new
 
69
    {
 
70
        my $class = shift ;
 
71
        my $filename = shift ;
 
72
        my $fh = gensym ;
 
73
        open ($fh, ">$filename") || die "Cannot open $filename: $!" ;
 
74
        my $real_stdout = select($fh) ;
 
75
        return bless [$fh, $real_stdout ] ;
 
76
 
 
77
    }
 
78
    sub DESTROY
 
79
    {
 
80
        my $self = shift ;
 
81
        close $self->[0] ;
 
82
        select($self->[1]) ;
 
83
    }
 
84
}
 
85
 
 
86
sub docat
 
87
{
 
88
    my $file = shift;
 
89
    local $/ = undef;
 
90
    open(CAT,$file) || die "Cannot open $file:$!";
 
91
    my $result = <CAT> || "" ;
 
92
    close(CAT);
 
93
    return $result;
 
94
}
 
95
 
 
96
sub docat_del
 
97
{ 
 
98
    my $file = shift;
 
99
    local $/ = undef;
 
100
    open(CAT,$file) || die "Cannot open $file: $!";
 
101
    my $result = <CAT> || "" ;
 
102
    close(CAT);
 
103
    unlink $file ;
 
104
    return $result;
 
105
}   
 
106
 
 
107
my $Dfile = "dbhash.tmp";
 
108
my $Dfile2 = "dbhash2.tmp";
 
109
my $Dfile3 = "dbhash3.tmp";
 
110
unlink $Dfile;
 
111
 
 
112
umask(0) ;
 
113
 
 
114
my $redirect = "xyzt" ;
 
115
 
 
116
 
 
117
{
 
118
my $redirect = "xyzt" ;
 
119
 {
 
120
 
 
121
    my $redirectObj = new Redirect $redirect ;
 
122
 
 
123
    use strict ;
 
124
    use BerkeleyDB ;
 
125
    
 
126
    my $filename = "fruit" ;
 
127
    unlink $filename ;
 
128
    my $db = new BerkeleyDB::Hash 
 
129
                -Filename => $filename, 
 
130
                -Flags    => DB_CREATE,
 
131
                -Property  => DB_DUP
 
132
        or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;
 
133
 
 
134
    # Add a few key/value pairs to the file
 
135
    $db->db_put("red", "apple") ;
 
136
    $db->db_put("orange", "orange") ;
 
137
    $db->db_put("green", "banana") ;
 
138
    $db->db_put("yellow", "banana") ;
 
139
    $db->db_put("red", "tomato") ;
 
140
    $db->db_put("green", "apple") ;
 
141
    
 
142
    # print the contents of the file
 
143
    my ($k, $v) = ("", "") ;
 
144
    my $cursor = $db->db_cursor() ;
 
145
    while ($cursor->c_get($k, $v, DB_NEXT) == 0)
 
146
      { print "$k -> $v\n" }
 
147
      
 
148
    undef $cursor ;
 
149
    undef $db ;
 
150
    unlink $filename ;
 
151
 }
 
152
 
 
153
  #print "[" . docat($redirect) . "]" ;
 
154
  ok(1, docat_del($redirect) eq <<'EOM') ;
 
155
orange -> orange
 
156
yellow -> banana
 
157
red -> apple
 
158
red -> tomato
 
159
green -> banana
 
160
green -> apple
 
161
EOM
 
162
 
 
163
}
 
164
 
 
165
{
 
166
my $redirect = "xyzt" ;
 
167
 {
 
168
 
 
169
    my $redirectObj = new Redirect $redirect ;
 
170
 
 
171
    use strict ;
 
172
    use BerkeleyDB ;
 
173
    
 
174
    my $filename = "fruit" ;
 
175
    unlink $filename ;
 
176
    my $db = new BerkeleyDB::Hash 
 
177
                -Filename => $filename, 
 
178
                -Flags    => DB_CREATE,
 
179
                -Property  => DB_DUP | DB_DUPSORT
 
180
        or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;
 
181
 
 
182
    # Add a few key/value pairs to the file
 
183
    $db->db_put("red", "apple") ;
 
184
    $db->db_put("orange", "orange") ;
 
185
    $db->db_put("green", "banana") ;
 
186
    $db->db_put("yellow", "banana") ;
 
187
    $db->db_put("red", "tomato") ;
 
188
    $db->db_put("green", "apple") ;
 
189
    
 
190
    # print the contents of the file
 
191
    my ($k, $v) = ("", "") ;
 
192
    my $cursor = $db->db_cursor() ;
 
193
    while ($cursor->c_get($k, $v, DB_NEXT) == 0)
 
194
      { print "$k -> $v\n" }
 
195
      
 
196
    undef $cursor ;
 
197
    undef $db ;
 
198
    unlink $filename ;
 
199
 }
 
200
 
 
201
  #print "[" . docat($redirect) . "]" ;
 
202
  ok(2, docat_del($redirect) eq <<'EOM') ;
 
203
orange -> orange
 
204
yellow -> banana
 
205
red -> apple
 
206
red -> tomato
 
207
green -> apple
 
208
green -> banana
 
209
EOM
 
210
 
 
211
}
 
212
 
 
213