Skip to content
This repository
Newer
Older
100644 305 lines (253 sloc) 7.346 kb
4a8e9304 » Martin Berends
2010-06-19 add new examples/postgresqlclient.p6
1 # postgresql test example 1 translated from C to Perl 6
2 # See http://www.postgresql.org/docs/9.0/static/libpq-example.html
3 # and more comments below.
4
5 use NativeCall; # from project 'zavolaj'
6
7 # -------- foreign function definitions in alphabetical order ----------
8
9 sub PQclear( OpaquePointer $res )
10 is native('libpq')
11 { ... }
12
13 sub PQconnectdb( Str $conninfo )
14 returns OpaquePointer
15 is native('libpq')
16 { ... }
17
18 sub PQerrorMessage( OpaquePointer $conn )
19 returns Str
20 is native('libpq')
21 { ... }
22
23 sub PQexec( OpaquePointer $conn, Str $command )
24 returns OpaquePointer
25 is native('libpq')
26 { ... }
27
28 sub PQfinish( OpaquePointer $conn )
29 is native('libpq')
30 { ... }
31
32 sub PQfname( OpaquePointer $res, Int $fieldnum )
33 returns Str
34 is native('libpq')
35 { ... }
36
37 sub PQgetvalue( OpaquePointer $res, Int $tuplenum, Int $fieldnum )
38 returns Str
39 is native('libpq')
40 { ... }
41
42 sub PQnfields( OpaquePointer $res )
43 returns Int
44 is native('libpq')
45 { ... }
46
47 sub PQntuples( OpaquePointer $res )
48 returns Int
49 is native('libpq')
50 { ... }
51
52 sub PQresultStatus( OpaquePointer $res )
53 returns Int
54 is native('libpq')
55 { ... }
56
57 sub PQstatus( OpaquePointer $conn )
58 returns Int
59 is native('libpq')
60 { ... }
61
62 # from libpq-fe.h These should of course be constants or perhaps even enums
63 sub CONNECTION_OK { 0 }
64 sub CONNECTION_BAD { 1 }
65
66 sub PGRES_EMPTY_QUERY { 0 }
67 sub PGRES_COMMAND_OK { 1 }
68 sub PGRES_TUPLES_OK { 2 }
69
70 sub exit_nicely(OpaquePointer $conn)
71 {
72 PQfinish($conn);
73 exit(1);
74 }
75
76 my $conninfo;
77 my $conn;
78 my $res;
79 my $nFields;
80 my $i,
81 my $j;
82
83 #
84 # If the user supplies a parameter on the command line, use it as the
85 # conninfo string; otherwise default to setting dbname=postgres and using
86 # environment variables or defaults for all other connection parameters.
87 #
88 if ( @*ARGS.elems > 0 ) {
89 $conninfo = @*ARGS[0];
90 }
91 else {
92 $conninfo = "host=localhost user=testuser password=testpass dbname=zavolaj";
93 }
94
95 # Make a connection to the database
96 say "connecting";
97 $conn = PQconnectdb($conninfo);
98
99 # Check to see that the backend connection was successfully made
100 if (PQstatus($conn) != CONNECTION_OK)
101 {
102 $*ERR.say: sprintf( "Connection to database failed: %s",
103 PQerrorMessage($conn));
104 exit_nicely($conn);
105 }
106
107 #
108 # Our test case here involves using a cursor, for which we must be inside
109 # a transaction block. We could do the whole thing with a single
110 # PQexec() of "select * from pg_database", but that's too trivial to make
111 # a good example.
112 #
113
114 # Start a transaction block
115 $res = PQexec($conn, "BEGIN");
116
117 if (PQresultStatus($res) != PGRES_COMMAND_OK)
118 {
119 $*ERR.say: sprintf("BEGIN command failed: %s", PQerrorMessage($conn));
120 PQclear($res);
121 exit_nicely($conn);
122 }
123
124 #
125 # Should PQclear PGresult whenever it is no longer needed to avoid memory
126 # leaks
127 #
128
129 PQclear($res);
130
131 #
132 # Fetch rows from pg_database, the system catalog of databases
133 #
134 $res = PQexec($conn, "DECLARE myportal CURSOR FOR select * from pg_database");
135 if (PQresultStatus($res) != PGRES_COMMAND_OK)
136 {
137 $*ERR.say: sprintf("DECLARE CURSOR failed: %s", PQerrorMessage($conn));
138 PQclear($res);
139 exit_nicely($conn);
140 }
141 PQclear($res);
142
143 $res = PQexec($conn, "FETCH ALL in myportal");
144 if (PQresultStatus($res) != PGRES_TUPLES_OK)
145 {
146 $*ERR.say: sprintf("FETCH ALL failed: %s", PQerrorMessage($conn));
147 PQclear($res);
148 exit_nicely($conn);
149 }
150
151 # first, print out the attribute names
152 $nFields = PQnfields($res);
153 loop ($i = 0; $i < $nFields; $i++) {
154 printf("%-15s", PQfname($res, $i));
155 }
156 printf("\n\n");
157
158
159 PQclear($res);
160
161 # close the portal ... we don't bother to check for errors ...
162 $res = PQexec($conn, "CLOSE myportal");
163 PQclear($res);
164
165 # end the transaction
166 $res = PQexec($conn, "END");
167 PQclear($res);
168
169 # the example 1 code is all done, now copy the mysqlclient example
170 say "DROP TABLE nom";
171 $res = PQexec($conn,"
172 DROP TABLE nom
173 ");
174 if (PQresultStatus($res) != PGRES_COMMAND_OK)
175 {
176 $*ERR.say: sprintf("DROP TABLE failed: %s", PQerrorMessage($conn));
177 }
178 PQclear($res);
179
180 say "CREATE TABLE nom";
181 $res = PQexec($conn,"
182 CREATE TABLE nom (
183 name char(4),
184 description char(30),
185 quantity int,
186 price numeric(5,2)
187 )
188 ");
189 if (PQresultStatus($res) != PGRES_COMMAND_OK)
190 {
191 $*ERR.say: sprintf("CREATE TABLE failed: %s", PQerrorMessage($conn));
192 PQclear($res);
193 exit_nicely($conn);
194 }
195 PQclear($res);
196
197 say "INSERT nom";
198 $res = PQexec($conn, "
199 INSERT INTO nom (name, description, quantity, price)
200 VALUES ( 'BUBH', 'Hot beef burrito', 1, 4.95 ),
201 ( 'TAFM', 'Mild fish taco', 1, 4.85 ),
202 ( 'BEOM', 'Medium size orange juice', 2, 1.20 )
203 ");
204 if (PQresultStatus($res) != PGRES_COMMAND_OK)
205 {
206 $*ERR.say: sprintf("INSERT nom failed: %s", PQerrorMessage($conn));
207 PQclear($res);
208 exit_nicely($conn);
209 }
210 PQclear($res);
211
212 say "SELECT *, quantity*price AS amount FROM nom";
213 $res = PQexec($conn, "
214 SELECT *, quantity*price AS amount FROM nom
215 ");
216
217 print "field_count ";
218 my $field_count = PQnfields($res);
219 say $field_count;
220
221 say "Columns:";
222 loop ( my $column_number=0; $column_number < $field_count; $column_number++ ) {
223 my $column_name = PQfname($res, $column_number);
224 say " $column_name";
225 }
226
227 print "row_count ";
228 my $row_count = PQntuples($res);
229 say $row_count;
230
231 # next, print out the rows
232 my @rows;
233 my @width = 0 xx $field_count;
234 loop ( my $row_number=0; $row_number < $row_count; $row_number++ ) {
235 my @row = ();
236 loop ( my $field_number = 0; $field_number < $field_count; $field_number++ ) {
237 my $field = PQgetvalue($res, $row_number, $field_number);
238 my $chars = $field.chars;
239 if $chars > @width[$field_number] {
240 @width[$field_number] = $chars;
241 }
242 push @row, $field;
243 }
244 push @rows, [@row];
245 }
246 # Having determined the column widths by measuring every field,
247 # it is finally possible to pretty print the table.
248
249 loop ( $j=0; $j < $field_count; $j++ ) {
250 print "+--";
251 print '-' x @width[$j];
252 }
253 say '+';
254 loop ( $i=0; $i<$row_count; $i++ ) {
255 my @row = @rows[$i];
256 loop ( $j=0; $j<$field_count; $j++ ) {
257 my $field = @row[0][$j];
258 print "| $field ";
259 print ' ' x ( @width[$j] - $field.chars );
260 }
261 say '|';
262 }
263 loop ( $j=0; $j<$field_count; $j++ ) {
264 print "+--";
265 print '-' x @width[$j];
266 }
267 say '+';
268
269 say "DROP TABLE nom";
270 $res = PQexec($conn,"
271 DROP TABLE nom
272 ");
273 if (PQresultStatus($res) != PGRES_COMMAND_OK)
274 {
275 $*ERR.say: sprintf("DROP TABLE failed: %s", PQerrorMessage($conn));
276 PQclear($res);
277 exit_nicely($conn);
278 }
279 PQclear($res);
280
281
282 # close the connection to the database and cleanup
283 PQfinish($conn);
284
285 =begin pod
286
287 =head1 PREREQUISITES
288 Your system should already have libpq-dev installed. Change to the
289 postgres user and connect to the postgres server as follows:
290
291 sudo -U postgres psql
292
293 Then set up a test environment with the following:
294
295 CREATE DATABASE zavolaj;
296 CREATE ROLE testuser LOGIN PASSWORD 'testpass';
297 GRANT ALL PRIVILEGES ON DATABASE zavolaj TO testuser;
298
299 The '\l' psql command output should include zavolaj as a database name.
300 Exit the psql client with a ^D, then try to use the new account:
301
302 psql --host=localhost --dbname=zavolaj --username=testuser --password
303 SELECT * FROM pg_database;
304
305 =end pod
Something went wrong with that request. Please try again.