1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
use strict;
use warnings;
use LWP::Simple;
use DBI;
use Cache::Memcached;
# NOTE: Env variable MEMCACHED_PORT is mandatory
# for this perl script to work.
my $memcached_port=$ENV{'MEMCACHED_PORT'} or die;
my $memd = new Cache::Memcached {
'servers' => [ "127.0.0.1:$memcached_port" ],
'connect_timeout' => 20,
'select_timeout' => 20
};
# /** Retrieve SDI stored in a tablespace for single copy.
# @param[in] type_full SDI type in format "sdi_<number>"
# @param[in] id SDI id
# @param[in] expected_data expected string to compare with SDI retrieved
# from tablespace. */
sub sdi_get_from_copy {
if (scalar(@_) ne 3) {
die "Wrong number of arguments passed."
. " Expected args: (id_full, type, expected_data)\n";
}
my $type_full = $_[0];
my $id = $_[1];
my $expected_data = $_[2];
my $val = $memd->get("$type_full:$id");
my $cmp_result = $expected_data eq $val;
if (!$cmp_result) {
print "input and output mismatch for rec($type_full:$id)";
print "input is $expected_data\n";
print "output is $val\n";
}
}
# /** Inserts SDI into both copies and retrieve SDI stored to compare with the
# given data.
# @param[in] type SDI type (just the number)
# @param[in] id SDI id
# @param[in] data data to be inserted */
sub sdi_set_get {
if (scalar(@_) ne 3) {
die "Wrong number of arguments passed."
. " Expected args: (type, id, data)\n";
}
my $type = $_[0];
my $type_full= "sdi_" . $type;
my $id = $_[1];
my $data = $_[2];
if (!$memd->set("$type_full:$id", $data)) {
print "Error: $type:$id|$data cannot be inserted.\n";
}
# Retrieve back and verify
sdi_get_from_copy($type_full, $id, $data);
}
# /** Removes SDI from both copies and verifies the operation by expecting empty
# output on get.
# @param[in] type SDI type
# @param[in] id SDi id */
sub sdi_remove_get {
if (scalar(@_) ne 2) {
die "Wrong number of arguments passed."
. " Expected args: (id, type)\n";
}
my $type = $_[0];
my $type_full= "sdi_" . $type;
my $id = $_[1];
my $ret = $memd->delete("$type_full:$id");
if (!$ret) {
print "Error: rec($id:$type) cannot be deleted\n";
}
# Retrieve from copy
my $val = $memd->get("$type_full:$id");
if ($val) {
print "Deleted but rec($type:$id) still exists with value:$val\n";
}
}
# /** Retrieve SDI from copy.
# @param[in] type SDI type
# @param[in] id SDI id */
sub sdi_get {
if (scalar(@_) ne 2) {
die "Wrong number of arguments passed."
. " Expected args: (type, id)\n";
}
my $type = $_[0];
my $type_full= "sdi_" . $type;
my $id = $_[1];
my $val = $memd->get("$type_full:$id");
# We don't print type & id because we use TABLE_ID as SDI KEY &
# type.
print "Get rec(type:id) is $val\n";
}
# /** Create SDI index in a tablespace. */
sub sdi_create_index {
$memd->get("sdi_create_");
}
# /** Removes SDI indexes in a tablespace. */
sub sdi_drop_index {
$memd->get("sdi_drop_");
}
# /** Select the table on which SDI operations should happen.
# @param[in] table_name table name */
sub sdi_switch_table {
if (scalar(@_) ne 1) {
die "Wrong number of arguments passed."
. " Expected args: (table_name)\n";
}
my $table_name = $_[0];
$memd->get("\@\@$table_name");
}
# /** Retrieves SDI keys only without data. (1:1|2:4|..) */
sub sdi_get_only_keys {
return $memd->get("sdi_list_");
}
# /** Disconnect the current memcached connection. */
sub sdi_disconnect {
$memd->disconnect_all;
}
# "require sdi_perl_func.pl" says the module should return true and this
# achieved by the below statement
1;
|
