Coverage report: /development/source/library/org/datagraph/spocq-shard/src/odbc/utility/odbc-uri.lisp

Kind	Covered	All	%
expression	7	358	2.0
branch	0	6	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-

2

3

(in-package :org.datagraph.spocq)

4

5

;;; define representation and manipularion for odbc uri

6

;;; (load "patches/odbc-uri.lisp")

7

8

(dsu:modpackage :org.datagraph.spocq

9

(:export :mysql-uri

10

:mysql-uri-p

11

:make-mysql-uri

12

:parse-mysql-uri

13

:mysql-uri-user

14

:mysql-uri-password

15

:mysql-uri-authority

16

:mysql-uri-port

17

:mysql-uri-database

18

:mysql-uri-parameters

19

:mysql-uri-table

20

:mysql-uri-schema

21

22

:odbc-uri

23

:odbc-uri-p

24

:make-odbc-uri

25

:parse-odbc-uri

26

:odbc-uri-driver

27

:odbc-uri-user

28

:odbc-uri-password

29

:odbc-uri-authority

30

:odbc-uri-port

31

:odbc-uri-database

32

:odbc-uri-table

33

:odbc-uri-query

34

35

:postgresql-uri

36

:postgresql-uri-p

37

:make-postgresql-uri

38

:parse-postgresql-uri

39

:postgresql-uri-user

40

:postgresql-uri-password

41

:postgresql-uri-authority

42

:postgresql-uri-port

43

:postgresql-uri-database

44

:postgresql-uri-parameters

45

:postgresql-uri-schema

46

47

:sql-uri

48

:sql-uri-p

49

:sql-uri-user

50

:sql-uri-password

51

:sql-uri-authority

52

:sql-uri-port

53

:sql-uri-database

54

))

55

56

(defstruct (sql-uri (:include iri (lexical-form "")))

57

;; retain the default constructor

58

user

59

password

60

authority

61

port

62

database

63

)

64

65

(defstruct (odbc-uri (:include sql-uri))

66

;; retain the default constructor

67

driver

68

table

69

query

70

)

71

72

(defstruct (postgresql-uri (:include sql-uri))

73

"the postgres url is defined as

74

postgresql://[user[:password]@][netloc][:port][/dbname][?param1=value1&...]

75

(see http://www.postgresql.org/docs/current/static/libpq-connect.html#LIBPQ-CONNSTRING)"

76

parameters

77

)

78

79

(defstruct (mysql-uri (:include sql-uri))

80

"the postgres url is defined as

81

postgresql://[user[:password]@][netloc][:port][/dbname][.table][?param1=value1&...]"

82

table

83

parameters

84

)

85

86

;;;

87

88

(defmethod print-object ((object sql-uri) stream)

89

(format stream "<~a>" (ensure-iri-lexical-form object)))

90

91

(defun spocq.i::sql-uri (lexical-form)

92

(spocq.i::construct-uri-term (spocq.i::parse-uri-scheme lexical-form) lexical-form))

93

94

95

;;; mysql

96

97

(defparameter *mysql-uri-scanner*

98

(cl-ppcre:create-scanner `(:sequence :start-anchor

99

(:sequence "mysql://"

100

                                                    (:greedy-repetition

101

0 1

102

(:sequence

103

                                                      (:greedy-repetition

104

0 1

105

(:sequence

106

                                                        (:greedy-repetition 0 1

107

                                                                            (:register

108

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\:))))

109

":"

110

                                                        (:greedy-repetition 0 1

111

                                                                            (:register

112

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\@))))

113

"@"))

114

                                                      (:greedy-repetition 0 1

115

                                                                          (:register

116

                                                                           (:greedy-repetition 1 nil (:inverted-char-class #\: #\/))))

117

                                                      (:greedy-repetition 0 1

118

                                                                          (:sequence ":"

119

                                                                                     (:register

120

                                                                                      (:greedy-repetition 1 nil (:inverted-char-class #\/)))))))

121

"/"

122

                                                    (:greedy-repetition

123

0 1

124

(:register

125

                                                      (:greedy-repetition 1 nil (:inverted-char-class #\? #\.))))

126

                                                    (:greedy-repetition

127

0 1

128

                                                     (:sequence #\.

129

                                                                (:register

130

                                                                 (:greedy-repetition 1 nil (:inverted-char-class #\? #\.)))))

131

                                                    (:greedy-repetition

132

0 1

133

(:sequence

134

"?"

135

                                                      (:greedy-repetition 0 1

136

                                                                          (:register

137

                                                                           (:greedy-repetition 1 nil :everything)))

138

)))

139

:end-anchor)))

140

141

(defun parse-mysql-uri (value)

142

(multiple-value-bind (whole strings)

143

(cl-ppcre:scan-to-strings *mysql-uri-scanner* value)

144

(if whole

145

         (values (loop for i from 0 for property in '(:user :password :authority :port :database :table :parameters)

146

for value = (aref strings i)

147

when value

148

append (list property (case property

149

                                           (:parameters (loop for assignment in (dsu:split-string value #\&)

150

                                                          for (key value) = (dsu:split-string assignment #\=)

151

                                                          collect (cons (dsu:cons-symbol :keyword key) value)))

152

(t value))))

153

whole)

154

(error "Invalid mysql uri lexical form: ~s" value))))

155

;;; (parse-mysql-uri "mysql://production:X5lhSMNlJVlK4O1d@localhost/test" )

156

 ;;; (spocq::parse-mysql-uri "mysql://production:X5lhSMNlJVlK4O1d@localhost/test.events?encoding=utf-8&schema=test" )

157

;;; (parse-mysql-uri "mysql://production:X5lhSMNlJVlK4O1d@localhost/test?table=events&encoding=utf-8" )

158

159

(defmethod ensure-iri-lexical-form ((uri mysql-uri))

160

(let ((value (mysql-uri-lexical-form uri)))

161

(if (plusp (length value))

162

value

163

(let ((user (mysql-uri-user uri))

164

(password (mysql-uri-password uri))

165

(authority (mysql-uri-authority uri))

166

(port (mysql-uri-port uri))

167

(database (mysql-uri-database uri))

168

(table (mysql-uri-table uri))

169

(parameters (mysql-uri-parameters uri)))

170

(setf (spocq::mysql-uri-lexical-form uri)

171

                 (format nil "mysql://~:[~5*~;~:[~2*~;~@[~a~]:~@[~a~]@~]~@[~a~]~@[:~a~]~]/~@[~a~]~@[.~a~]~@[?~{~a=~a~^&~}~]"

172

(or user password authority port) (or user password)

173

user password authority port

174

database

175

table

176

(loop for (key . value) in parameters

177

collect (string-downcase key)

178

collect value)))))))

179

180

(defgeneric spocq.i::mysql-uri (value)

181

(:method ((lexical-form cl:string))

182

(multiple-value-bind (initargs lexical-form) (spocq:parse-mysql-uri lexical-form)

183

(apply #'spocq:make-mysql-uri :lexical-form lexical-form initargs)))

184

(:method ((uri spocq:mysql-uri))

185

(ensure-iri-lexical-form uri)))

186

187

(defgeneric mysql-uri-schema (uri)

188

(:method ((uri mysql-uri))

189

(rest (assoc :schema (mysql-uri-parameters uri)))))

190

191

;;; odbc

192

193

(defparameter *odbc-uri-scanner*

194

(cl-ppcre:create-scanner `(:sequence :start-anchor

195

(:sequence "odbc:"

196

                                                    (:greedy-repetition 0 1

197

                                                                        (:register

198

                                                                         (:greedy-repetition 1 nil (:inverted-char-class #\/))))

199

"//"

200

                                                    (:greedy-repetition

201

0 1

202

(:sequence

203

                                                      (:greedy-repetition

204

0 1

205

(:sequence

206

                                                        (:greedy-repetition 0 1

207

                                                                            (:register

208

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\:))))

209

":"

210

                                                        (:greedy-repetition 0 1

211

                                                                            (:register

212

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\@))))

213

"@"))

214

                                                      (:greedy-repetition 0 1

215

                                                                          (:register

216

                                                                           (:greedy-repetition 1 nil (:inverted-char-class #\: #\/))))

217

                                                      (:greedy-repetition 0 1

218

                                                                          (:sequence ":"

219

                                                                                     (:register

220

                                                                                      (:greedy-repetition 1 nil (:inverted-char-class #\/)))))))

221

"/"

222

                                                    (:greedy-repetition 0 1

223

                                                                        (:register

224

                                                                         (:greedy-repetition 1 nil (:inverted-char-class #\/))))

225

                                                    (:greedy-repetition

226

0 1

227

(:sequence

228

"/"

229

                                                        (:greedy-repetition 0 1

230

                                                                            (:register

231

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\?))))

232

                                                        (:greedy-repetition

233

0 1

234

                                                         (:sequence

235

"?"

236

                                                          (:greedy-repetition 0 1

237

                                                                              (:register

238

                                                                               (:greedy-repetition 1 nil :EVERYTHING))))))))

239

:end-anchor)))

240

241

;;; odbc:[driver]//[user]:[password]@[host]:[port]/[database]/[tables]?[query]

242

;;; components: all, driver, user, password, host, port, database, table, query

243

244

(defun parse-odbc-uri (value)

245

(multiple-value-bind (whole strings)

246

(cl-ppcre:scan-to-strings *odbc-uri-scanner* value)

247

(if whole

248

       (values (loop for i from 0 for property in '(:driver :user :password :authority :port :database :table :query)

249

for value = (aref strings i)

250

when value append (list property value))

251

whole)

252

(error "Invalid odbc uri lexical form: ~s" value))))

253

254

(defmethod ensure-iri-lexical-form ((uri odbc-uri))

255

(let ((value (odbc-uri-lexical-form uri)))

256

(if (plusp (length value))

257

value

258

(let ((driver (odbc-uri-driver uri))

259

(user (odbc-uri-user uri))

260

(password (odbc-uri-password uri))

261

(authority (odbc-uri-authority uri))

262

(port (odbc-uri-port uri))

263

(database (odbc-uri-database uri))

264

(table (odbc-uri-table uri))

265

(query (odbc-uri-query uri)))

266

(setf (spocq::odbc-uri-lexical-form uri)

267

                 (format nil "odbc:~@[~a~]//~:[~5*~;~:[~2*~;~@[~a~]:~@[~a~]@~]~@[~a~]~@[:~a~]~]/~@[~a~]/~@[~a~]~@[?~a~]"

268

driver

269

(or user password authority port) (or user password)

270

user password authority port

271

database table query))))))

272

273

(defgeneric spocq.i::odbc-uri (value)

274

(:method ((lexical-form cl:string))

275

(multiple-value-bind (initargs lexical-form) (spocq:parse-odbc-uri lexical-form)

276

(apply #'spocq:make-odbc-uri :lexical-form lexical-form initargs)))

277

(:method ((uri spocq:odbc-uri))

278

(ensure-iri-lexical-form uri)))

279

280

;;; postgres

281

282

(defparameter *postgresql-uri-scanner*

283

(cl-ppcre:create-scanner `(:sequence :start-anchor

284

(:sequence "postgresql://"

285

                                                    (:greedy-repetition

286

0 1

287

(:sequence

288

                                                      (:greedy-repetition

289

0 1

290

(:sequence

291

                                                        (:greedy-repetition 0 1

292

                                                                            (:register

293

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\:))))

294

":"

295

                                                        (:greedy-repetition 0 1

296

                                                                            (:register

297

                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\@))))

298

"@"))

299

                                                      (:greedy-repetition 0 1

300

                                                                          (:register

301

                                                                           (:greedy-repetition 1 nil (:inverted-char-class #\: #\/))))

302

                                                      (:greedy-repetition 0 1

303

                                                                          (:sequence ":"

304

                                                                                     (:register

305

                                                                                      (:greedy-repetition 1 nil (:inverted-char-class #\/)))))))

306

"/"

307

                                                    (:greedy-repetition 0 1

308

                                                                        (:register

309

                                                                         (:greedy-repetition 1 nil (:inverted-char-class #\?))))

310

                                                    (:greedy-repetition

311

0 1

312

(:sequence

313

"?"

314

                                                        (:greedy-repetition 0 1

315

                                                                            (:register

316

                                                                             (:greedy-repetition 1 nil :everything)))

317

)))

318

:end-anchor)))

319

320

(defun parse-postgresql-uri (value)

321

(multiple-value-bind (whole strings)

322

(cl-ppcre:scan-to-strings *postgresql-uri-scanner* value)

323

(if whole

324

       (values (loop for i from 0 for property in '(:user :password :authority :port :database :parameters)

325

for value = (aref strings i)

326

when value

327

append (list property (case property

328

                                         (:parameters (loop for assignment in (dsu:split-string value #\&)

329

                                                        for (key value) = (dsu:split-string assignment #\=)

330

                                                        collect (cons (dsu:cons-symbol :keyword key) value)))

331

(t value))))

332

whole)

333

(error "Invalid postgres uri lexical form: ~s" value))))

334

335

;;; (parse-postgresql-uri "postgresql://postgres:postgres@localhost/test" )

336

;;; (parse-postgresql-uri "postgresql://postgres:postgres@localhost/test?table=events&encoding=utf-8" )

337

338

(defmethod ensure-iri-lexical-form ((uri postgresql-uri))

339

(let ((value (postgresql-uri-lexical-form uri)))

340

(if (plusp (length value))

341

value

342

(let ((user (postgresql-uri-user uri))

343

(password (postgresql-uri-password uri))

344

(authority (postgresql-uri-authority uri))

345

(port (postgresql-uri-port uri))

346

(database (postgresql-uri-database uri))

347

(parameters (postgresql-uri-parameters uri)))

348

(setf (spocq::postgresql-uri-lexical-form uri)

349

                 (format nil "postgresql://~:[~5*~;~:[~2*~;~@[~a~]:~@[~a~]@~]~@[~a~]~@[:~a~]~]/~@[~a~]~@[?~{~a=~a~^&~}~]"

350

(or user password authority port) (or user password)

351

user password authority port

352

database

353

(loop for (key . value) in parameters

354

collect (string-downcase key)

355

collect value)))))))

356

357

(defgeneric spocq.i::postgresql-uri (value)

358

(:method ((lexical-form cl:string))

359

(multiple-value-bind (initargs lexical-form) (spocq:parse-postgresql-uri lexical-form)

360

(apply #'spocq:make-postgresql-uri :lexical-form lexical-form initargs)))

361

(:method ((uri spocq:postgresql-uri))

362

(ensure-iri-lexical-form uri)))

363

364

(defgeneric postgresql-uri-schema (uri)

365

(:method ((uri postgresql-uri))

366

(rest (assoc :schema (postgresql-uri-parameters uri)))))

367

368

369

(defmethod spocq.i::iri-lexical-form ((uri sql-uri))

370

(ensure-iri-lexical-form uri))

371

372

(defmethod spocq.i::parse-uri-by-scheme ((type (eql :mysql)) string)

373

(spocq.i::mysql-uri string))

374

(defmethod spocq.i::parse-uri-by-scheme ((type (eql :odbc)) string)

375

(spocq.i::odbc-uri string))

376

(defmethod spocq.i::parse-uri-by-scheme ((type (eql :postgresql)) string)

377

(spocq.i::postgresql-uri string))

378

379

(defmethod spocq.i::construct-uri-term ((scheme (eql :mysql)) lexical-form)

380

(spocq.i::mysql-uri lexical-form))

381

(defmethod spocq.i::construct-uri-term ((scheme (eql :odbc)) lexical-form)

382

(spocq.i::odbc-uri lexical-form))

383

(defmethod spocq.i::construct-uri-term ((scheme (eql :postgresql)) lexical-form)

384

(spocq.i::postgresql-uri lexical-form))

385

386

;;; (parse-odbc-uri "odbc://:@:/postgresdb/aTable?")

387

;;; (parse-odbc-uri "odbc:Postgres64////aTable")

388

;;; (parse-odbc-uri "odbc://user:password@localhost:0000/postgresdb/aTable?")

389

;;; (parse-odbc-uri "odbc://localhost:0000/postgresdb/aTable?")

390

;;; (parse-odbc-uri "odbc://localhost/postgresdb/aTable?")

391

392

;;; (spocq.i::odbc-uri "odbc://localhost:0000/postgresdb/aTable?")

393

394

(defgeneric spocq.i::merge-sql-uri (uri1 uri2)

395

(:method ((uri1 cl:string) (uri2 t))

396

(spocq.i::merge-sql-uri (spocq.i::sql-uri uri1) uri2))

397

(:method ((uri1 t) (uri2 cl:string))

398

(spocq.i::merge-sql-uri uri1 (spocq.i::sql-uri uri2)))

399

400

(:method ((uri1 list) (uri2 mysql-uri))

401

(spocq.i::merge-sql-uri (apply #'make-mysql-uri uri1) uri2))

402

(:method ((uri1 mysql-uri) (uri2 list))

403

(spocq.i::merge-sql-uri uri1 (apply #'make-mysql-uri uri2)))

404

405

(:method ((uri1 list) (uri2 odbc-uri))

406

(spocq.i::merge-sql-uri (apply #'make-odbc-uri uri1) uri2))

407

(:method ((uri1 odbc-uri) (uri2 list))

408

(spocq.i::merge-sql-uri uri1 (apply #'make-odbc-uri uri2)))

409

410

(:method ((uri1 list) (uri2 postgresql-uri))

411

(spocq.i::merge-sql-uri (apply #'make-postgresql-uri uri1) uri2))

412

(:method ((uri1 postgresql-uri) (uri2 list))

413

(spocq.i::merge-sql-uri uri1 (apply #'make-postgresql-uri uri2)))

414

415

(:method ((uri1 odbc-uri) (uri2 odbc-uri))

416

(let ((driver (or (odbc-uri-driver uri1) (odbc-uri-driver uri2)))

417

(user (or (odbc-uri-user uri1) (odbc-uri-user uri2)))

418

(password (or (odbc-uri-password uri1) (odbc-uri-password uri2)))

419

(authority (or (odbc-uri-authority uri1) (odbc-uri-authority uri2)))

420

(port (or (odbc-uri-port uri1) (odbc-uri-port uri2)))

421

(database (or (odbc-uri-database uri1) (odbc-uri-database uri2)))

422

(table (or (odbc-uri-table uri1) (odbc-uri-table uri2)))

423

(query (or (odbc-uri-query uri1) (odbc-uri-query uri2))))

424

(make-odbc-uri :lexical-form ""

425

:driver driver

426

:user user

427

:password password

428

:authority authority

429

:port port

430

:database database

431

:table table

432

:query query)))

433

(:method ((uri1 postgresql-uri) (uri2 postgresql-uri))

434

(let ((user (or (postgresql-uri-user uri1) (postgresql-uri-user uri2)))

435

(password (or (postgresql-uri-password uri1) (postgresql-uri-password uri2)))

436

(authority (or (postgresql-uri-authority uri1) (postgresql-uri-authority uri2)))

437

(port (or (postgresql-uri-port uri1) (postgresql-uri-port uri2)))

438

(database (or (postgresql-uri-database uri1) (postgresql-uri-database uri2)))

439

(parameters (remove-duplicates (append (postgresql-uri-parameters uri1)

440

                                                  (postgresql-uri-parameters uri2))

441

:key #'first :from-end t)))

442

(make-postgresql-uri :lexical-form ""

443

:user user

444

:password password

445

:authority authority

446

:port port

447

:database database

448

:parameters parameters))))

449

450

;;; (spocq.i::merge-sql-uri "odbc:Postgres64////aTable" "odbc://localhost:0000/postgresdb/?")

451

;;; (spocq.i::merge-sql-uri "odbc:Postgres64////aTable" '(:table "test"))

452

;;; (spocq.i::merge-sql-uri '(:table "test") "odbc:Postgres64///adatabase/aTable")

453

;;; (spocq.i::merge-sql-uri '(:table "test") "postgresql:///adatabase/")

454

455