├── LICENSE ├── README.md ├── doc └── mgsql.pdf ├── isc └── mgsql_isc.ro ├── m └── mgsql.ro ├── odbc ├── afxres.h ├── catalog.c ├── connect.c ├── desc.c ├── execute.c ├── handle.c ├── info.c ├── mgodbc.c ├── mgodbc.def ├── mgodbc.h ├── mgodbc.rc ├── mgodbc.vcxproj ├── options.c ├── prepare.c ├── resource.h ├── results.c ├── setup.c ├── transact.c ├── x64 │ ├── mgodbc.dll │ └── mgodbc64.reg └── x86 │ ├── mgodbc.dll │ └── mgodbc32.reg ├── unix ├── mgsql_xinetd └── mgsql_ydb └── yottadb ├── _mgsql.m ├── _mgsqlc.m ├── _mgsqlc1.m ├── _mgsqlc2.m ├── _mgsqlc3.m ├── _mgsqlc4.m ├── _mgsqlc5.m ├── _mgsqlc6.m ├── _mgsqlcd.m ├── _mgsqlci.m ├── _mgsqlct.m ├── _mgsqlcu.m ├── _mgsqld.m ├── _mgsqle.m ├── _mgsqle1.m ├── _mgsqle2.m ├── _mgsqln.m ├── _mgsqln1.m ├── _mgsqln2.m ├── _mgsqlo.m ├── _mgsqlo1.m ├── _mgsqlo2.m ├── _mgsqlp.m ├── _mgsqlp1.m ├── _mgsqlr.m ├── _mgsqls.m ├── _mgsqlv.m ├── _mgsqlv1.m ├── _mgsqlv2.m ├── _mgsqlv3.m ├── _mgsqlv4.m ├── _mgsqlv5.m ├── _mgsqlv6.m ├── _mgsqlw.m ├── _mgsqlx.m └── _mgsqlz.m /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /doc/mgsql.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chrisemunt/mgsql/e63e220cc5991c686154fe7220170a0d55024151/doc/mgsql.pdf -------------------------------------------------------------------------------- /odbc/afxres.h: -------------------------------------------------------------------------------- 1 | //#include "afxres.h" 2 | #include "WinResrc.h" 3 | #define IDC_STATIC -1 4 | -------------------------------------------------------------------------------- /odbc/mgodbc.def: -------------------------------------------------------------------------------- 1 | LIBRARY "mgodbc" 2 | 3 | HEAPSIZE 4096 4 | 5 | EXPORTS 6 | SQLAllocConnect @1 7 | SQLAllocEnv @2 8 | SQLAllocHandle @3 9 | SQLAllocStmt @4 10 | SQLBindCol @5 11 | SQLBindParameter @6 12 | SQLBrowseConnect @7 13 | SQLBulkOperations @8 14 | SQLCancel @9 15 | SQLCloseCursor @10 16 | SQLColAttribute @11 17 | SQLColAttributes @12 18 | SQLColumnPrivileges @13 19 | SQLColumns @14 20 | SQLConnect @15 21 | SQLCopyDesc @16 22 | SQLDataSources @17 23 | SQLDescribeCol @18 24 | SQLDescribeParam @19 25 | SQLDisconnect @20 26 | SQLDriverConnect @21 27 | SQLDrivers @22 28 | SQLEndTran @23 29 | SQLError @24 30 | SQLExecDirect @25 31 | SQLExecute @26 32 | SQLExtendedFetch @27 33 | SQLFetch @28 34 | SQLFetchScroll @29 35 | SQLForeignKeys @30 36 | SQLFreeConnect @31 37 | SQLFreeEnv @32 38 | SQLFreeHandle @33 39 | SQLFreeStmt @34 40 | SQLGetConnectAttr @35 41 | SQLGetConnectOption @36 42 | SQLGetCursorName @37 43 | SQLGetData @38 44 | SQLGetDescField @39 45 | SQLGetDescRec @40 46 | SQLGetDiagField @41 47 | SQLGetDiagRec @42 48 | SQLGetEnvAttr @43 49 | SQLGetFunctions @44 50 | SQLGetInfo @45 51 | SQLGetStmtAttr @46 52 | SQLGetStmtOption @47 53 | SQLGetTypeInfo @48 54 | SQLMoreResults @49 55 | SQLNativeSql @50 56 | SQLNumParams @51 57 | SQLNumResultCols @52 58 | SQLParamData @53 59 | SQLParamOptions @54 60 | SQLPrepare @55 61 | SQLPrimaryKeys @56 62 | SQLProcedureColumns @57 63 | SQLProcedures @58 64 | SQLPutData @59 65 | SQLRowCount @60 66 | SQLSetConnectAttr @61 67 | SQLSetConnectOption @62 68 | SQLSetCursorName @63 69 | SQLSetDescField @64 70 | SQLSetDescRec @65 71 | SQLSetEnvAttr @66 72 | SQLSetParam @67 73 | SQLSetPos @68 74 | SQLSetScrollOptions @69 75 | SQLSetStmtAttr @70 76 | SQLSetStmtOption @71 77 | SQLSpecialColumns @72 78 | SQLStatistics @73 79 | SQLTablePrivileges @74 80 | SQLTables @75 81 | SQLTransact @76 82 | 83 | ConfigDSN @77 84 | ConfigDriver @78 85 | ConfigTranslator @79 86 | 87 | DllMain @80 88 | -------------------------------------------------------------------------------- /odbc/mgodbc.rc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chrisemunt/mgsql/e63e220cc5991c686154fe7220170a0d55024151/odbc/mgodbc.rc -------------------------------------------------------------------------------- /odbc/resource.h: -------------------------------------------------------------------------------- 1 | //{{NO_DEPENDENCIES}} 2 | // Microsoft Visual C++ generated include file. 3 | // Used by mgodbc.rc 4 | // 5 | #define IDD_ABOUT 101 6 | #define IDD_CONFIGDSN 107 7 | #define IDC_BUTTON1 1000 8 | #define IDC_BUTTON_CANCEL 1000 9 | #define IDC_BUTTON_ABOUTOK 1000 10 | #define IDC_BUTTON_SAVE 1001 11 | #define IDC_EDIT_NAME 1002 12 | #define IDC_EDIT_DESC 1003 13 | #define IDC_EDIT_SERVER 1004 14 | #define IDC_EDIT_PORT 1005 15 | #define IDC_EDIT_UCI 1006 16 | #define IDC_BUTTON_ABOUT 1007 17 | #define IDC_EDIT1 1008 18 | #define IDC_EDIT_ELF 1008 19 | #define IDC_EDIT_UCI3 1009 20 | #define IDC_EDIT_ELL 1009 21 | 22 | // Next default values for new objects 23 | // 24 | #ifdef APSTUDIO_INVOKED 25 | #ifndef APSTUDIO_READONLY_SYMBOLS 26 | #define _APS_NEXT_RESOURCE_VALUE 104 27 | #define _APS_NEXT_COMMAND_VALUE 40001 28 | #define _APS_NEXT_CONTROL_VALUE 1009 29 | #define _APS_NEXT_SYMED_VALUE 101 30 | #endif 31 | #endif 32 | -------------------------------------------------------------------------------- /odbc/transact.c: -------------------------------------------------------------------------------- 1 | /* 2 | ---------------------------------------------------------------------------- 3 | | MGODBC: ODBC Driver for MGSQL | 4 | | Author: Chris Munt cmunt@mgateway.com | 5 | | chris.e.munt@gmail.com | 6 | | Copyright (c) 2016-2023 MGateway Ltd | 7 | | Surrey UK. | 8 | | All rights reserved. | 9 | | | 10 | | http://www.mgateway.com | 11 | | | 12 | | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | | not use this file except in compliance with the License. | 14 | | You may obtain a copy of the License at | 15 | | | 16 | | http://www.apache.org/licenses/LICENSE-2.0 | 17 | | | 18 | | Unless required by applicable law or agreed to in writing, software | 19 | | distributed under the License is distributed on an "AS IS" BASIS, | 20 | | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | | See the License for the specific language governing permissions and | 22 | | limitations under the License. | 23 | ---------------------------------------------------------------------------- 24 | */ 25 | 26 | #include "mgodbc.h" 27 | 28 | 29 | /* SQLC transaction control functions. */ 30 | 31 | /* *** Deprecated *** */ 32 | RETCODE SQL_API SQLTransact(HENV henv, HDBC hdbc, UWORD fType) 33 | { 34 | #ifdef _WIN32 35 | __try { 36 | #endif 37 | if (CoreData.ftrace == 1) { 38 | mg_log_event("", "SQLTransact", 0, NULL, 0); 39 | } 40 | return SQL_SUCCESS; 41 | 42 | #ifdef _WIN32 43 | } 44 | __except (EXCEPTION_EXECUTE_HANDLER) { 45 | 46 | DWORD code; 47 | char buffer[256]; 48 | 49 | __try { 50 | code = GetExceptionCode(); 51 | sprintf(buffer, "Exception caught in SQLTransact(): %x", code); 52 | mg_log_event(buffer, "Error Condition", 0, NULL, 0); 53 | } 54 | __except (EXCEPTION_EXECUTE_HANDLER) { 55 | ; 56 | } 57 | 58 | return SQL_ERROR; 59 | } 60 | #endif 61 | 62 | } 63 | 64 | 65 | SQLRETURN SQL_API SQLEndTran(SQLSMALLINT HandleType, SQLHANDLE Handle, SQLSMALLINT CompletionType) 66 | { 67 | 68 | #ifdef _WIN32 69 | __try { 70 | #endif 71 | if (CoreData.ftrace == 1) { 72 | mg_log_event("", "SQLEndTran", 0, NULL, 0); 73 | } 74 | 75 | return SQL_SUCCESS; 76 | 77 | #ifdef _WIN32 78 | } 79 | __except (EXCEPTION_EXECUTE_HANDLER) { 80 | 81 | DWORD code; 82 | char buffer[256]; 83 | 84 | __try { 85 | code = GetExceptionCode(); 86 | sprintf(buffer, "Exception caught in SQLEndTran(): %x", code); 87 | mg_log_event(buffer, "Error Condition", 0, NULL, 0); 88 | } 89 | __except (EXCEPTION_EXECUTE_HANDLER) { 90 | ; 91 | } 92 | 93 | return SQL_ERROR; 94 | } 95 | #endif 96 | 97 | } 98 | 99 | -------------------------------------------------------------------------------- /odbc/x64/mgodbc.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chrisemunt/mgsql/e63e220cc5991c686154fe7220170a0d55024151/odbc/x64/mgodbc.dll -------------------------------------------------------------------------------- /odbc/x64/mgodbc64.reg: -------------------------------------------------------------------------------- 1 | Windows Registry Editor Version 5.00 2 | 3 | [HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\MGSQL ODBC x64] 4 | "Driver"="C:\\Program Files\\mgsql\\mgodbc.dll" 5 | "Setup"="C:\\Program Files\\mgsql\\mgodbc.dll" 6 | "APILevel"="1" 7 | "ConnectFunctions"="YYN" 8 | "DEBUG"=dword:00000000 9 | "DriverODBCVer"="03.50" 10 | "FileUsage"="0" 11 | "SQLLevel"="1" 12 | "UsageCount"=dword:00000001 13 | 14 | [HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers] 15 | "MGSQL ODBC x64"="Installed" -------------------------------------------------------------------------------- /odbc/x86/mgodbc.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chrisemunt/mgsql/e63e220cc5991c686154fe7220170a0d55024151/odbc/x86/mgodbc.dll -------------------------------------------------------------------------------- /odbc/x86/mgodbc32.reg: -------------------------------------------------------------------------------- 1 | Windows Registry Editor Version 5.00 2 | 3 | [HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\ODBC\ODBCINST.INI\MGSQL ODBC x86] 4 | "Driver"="C:\\Program Files (x86)\\mgsql\\mgodbc.dll" 5 | "Setup"="C:\\Program Files (x86)\\mgsql\\mgodbc.dll" 6 | "APILevel"="1" 7 | "ConnectFunctions"="YYN" 8 | "DEBUG"=dword:00000000 9 | "DriverODBCVer"="03.50" 10 | "FileUsage"="0" 11 | "SQLLevel"="1" 12 | "UsageCount"=dword:00000001 13 | 14 | [HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\ODBC\ODBCINST.INI\ODBC Drivers] 15 | "MG ODBC"="Installed" -------------------------------------------------------------------------------- /unix/mgsql_xinetd: -------------------------------------------------------------------------------- 1 | service mgsql_xinetd 2 | { 3 | disable = no 4 | type = UNLISTED 5 | port = 7041 6 | socket_type = stream 7 | wait = no 8 | user = root 9 | server = /usr/local/lib/yottadb/r122/mgsql_ydb 10 | } 11 | 12 | -------------------------------------------------------------------------------- /unix/mgsql_ydb: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | cd /usr/local/lib/yottadb/r122 3 | export ydb_dir=/root/.yottadb 4 | export ydb_dist=/usr/local/lib/yottadb/r122 5 | export ydb_routines="/root/.yottadb/r1.22_x86_64/o*(/root/.yottadb/r1.22_x86_64/r /root/.yottadb/r) /usr/local/lib/yottadb/r122/libyottadbutil.so" 6 | export ydb_gbldir="/root/.yottadb/r1.22_x86_64/g/yottadb.gld" 7 | $ydb_dist/ydb -r xinetd^%mgsql 8 | 9 | -------------------------------------------------------------------------------- /yottadb/_mgsqlc3.m: -------------------------------------------------------------------------------- 1 | %mgsqlc3 ;(CM) sql compiler ; 28 Jan 2022 9:57 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlc3") q 26 | ; 27 | endsq ; code to be executed on leaving a sub-query 28 | s line=%z("dl")_%z("pt")_qnum_"x"_%z("dl") 29 | i $d(^mgtmp($j,"group",qnum)) d regroup g endsqx 30 | d endsq1 31 | i qnum'=1 s line=line_" q" d addline^%mgsqlc(grp,.line) g endsqx 32 | i qnum=1,$d(^mgtmp($j,"order")) d reorder g endsqx 33 | s line=line_" g "_%z("dl")_%z("pt")_$s($d(sql("union",qnum)):nxtun_"s",1:"x")_%z("dl") d addline^%mgsqlc(grp,.line) 34 | endsqx i qnum=1,$d(eof("l")) s line=%z("dl")_%z("pt")_"d"_%z("dl")_" ;" d addline^%mgsqlc(grp,.line) 35 | q 36 | ; 37 | endsq1 ; unique result but expected as a list 38 | n com 39 | i qnum=1,$g(^mgtmp($j,"unique",qnum)) d row(grp,qnum,0,"") 40 | i qnum=1 q 41 | i '$g(^mgtmp($j,"unique",qnum)) q 42 | s com=^mgtmp($j,"sqcom",qnum) 43 | i com'["in",com'["exists" q 44 | s line=line_" ;" d addline^%mgsqlc(grp,.line) 45 | d outrowsq^%mgsqlc2 46 | q 47 | ; 48 | regroup ; reorganise data for 'group by' clause 49 | n i,codezo,x,sort2,funtyp,sort2 50 | i line'="" s line=line_" ; groups" d addline^%mgsqlc(grp,.line) 51 | s sort2=0 i qnum=1,$d(^mgtmp($j,"order")) s sort2=1 52 | i sort2 s line=" k "_%z("ctg")_"("_%z("cts")_","_"""x2"")"_" s "_%z("pv")_"n=0" d addline^%mgsqlc(grp,.line) 53 | s (keyo,como)="" f i=1:1 q:'$d(^mgtmp($j,"group",qnum,i)) d 54 | . s x=$g(^mgtmp($j,"group",qnum,i,0)) 55 | . s varo=%z("dsv")_"__order"_i_%z("dsv") 56 | . s dir=$p(x,"~",2),dir=$s(dir="desc":-1,1:1) 57 | . s line=" s "_varo_"=""""" d addline^%mgsqlc(grp,.line) 58 | . d reorder1(grp,qnum,i,.keyo,varo,.como,.tag,sort2,dir) 59 | . q 60 | s x="" f s x=$o(^mgtmp($j,"sqag",qnum,x)) q:x="" s fun="" f s fun=$o(^mgtmp($j,"sqag",qnum,x,fun)) q:fun="" d 61 | . s funtyp=$p(fun,"_",1) 62 | . i funtyp'="avg",funtyp'="min" q 63 | . s line=" s "_%z("vdata")_"=$g("_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_","_^mgtmp($j,"sqag",qnum,x,fun)_"))" d addline^%mgsqlc(grp,.line) 64 | . s line=" s "_%z("vdata")_"=$p("_%z("vdata")_",""#"",1)" d addline^%mgsqlc(grp,.line) 65 | . s line=" s "_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_","_^mgtmp($j,"sqag",qnum,x,fun)_")="_%z("vdata") d addline^%mgsqlc(grp,.line) 66 | . q 67 | i $d(^mgtmp($j,"having",1)) d having(grp,qnum,keyo,tag) 68 | i sort2 d sort2(grp,qnum,.keyo) 69 | s codezo=" m "_"%zo("_%z("vrc")_")="_%z("ctg")_"("_%z("cts")_","""_$s(sort2:"x2",1:"x")_""","_qnum_","_keyo_")" 70 | i qnum=1 s %data=0,%zq("tagp")=tag d row(grp,qnum,1,codezo),top(grp,qnum,1) s line=line_" g "_%zq("tagp") d addline^%mgsqlc(grp,.line) q 71 | i qnum'=1 d 72 | . s %zq("tag",qnum)=tag 73 | . s line=" s "_^mgtmp($j,"sel",qnum,1)_"="_%z("pv")_"d" d addline^%mgsqlc(grp,.line) 74 | . d outsq^%mgsqlc2 75 | . q 76 | q 77 | ; 78 | having(grp,qnum,keyo,tag) ; set up test for 'having' clause 79 | n i,x,fun 80 | s line="" 81 | f i=1:1 q:'$d(^mgtmp($j,"having",i)) s x=^mgtmp($j,"having",i) d s line=line_x 82 | . i x'[%z("dsv") q 83 | . s x=$p(x,%z("dsv"),2),fun=$p(x,"(",1),x=$p($p(x,"(",2,999),")",1) 84 | . s x="$g("_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_","_^mgtmp($j,"sqag",qnum,x,fun)_"))" 85 | . q 86 | i line="" q 87 | s line=" i '("_line_") g "_tag d addline^%mgsqlc(grp,.line) 88 | q 89 | ; 90 | reorder ; reorder data for 'order by' clause 91 | n i,com,como,key0,varo,codezo,x,sort2 92 | s sort2=0 93 | s line=line_" s (",com="" 94 | f i=1:1 q:'$d(^mgtmp($j,"order",i)) s line=line_com_%z("dsv")_"__order"_$p(^mgtmp($j,"order",i,0),"~",1)_%z("dsv"),com="," 95 | s line=line_","_%z("pv")_"n)=""""" d addline^%mgsqlc(grp,.line) 96 | s (keyo,como)="" f i=1:1 q:'$d(^mgtmp($j,"order",i)) d 97 | . s x=$g(^mgtmp($j,"order",i,0)) 98 | . s varo=%z("dsv")_"__order"_$p(x,"~",1)_%z("dsv") 99 | . s dir=$p(x,"~",2),dir=$s(dir="desc":-1,1:1) 100 | . d reorder1(grp,qnum,i,.keyo,varo,.como,.tag,sort2,dir) 101 | . q 102 | s tag=%z("dl")_%z("pt")_qnum_"o"_(i)_%z("dl"),%zq("tagp")=%z("dl")_%z("pt")_qnum_"o"_(i-1)_%z("dl") 103 | s line=tag_" s "_%z("pv")_"n=$o("_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_","_%z("pv")_"n))"_" i "_%z("pv")_"n="""" g "_%zq("tagp") d addline^%mgsqlc(grp,.line) 104 | s codezo=" m "_"%zo("_%z("vrc")_")="_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_","_%z("pv")_"n"_")" 105 | s %data=0,%zq("tagp")=tag d row(grp,qnum,1,codezo),top(grp,qnum,1) s line=line_" g "_%zq("tagp") d addline^%mgsqlc(grp,.line) q 106 | q 107 | ; 108 | reorder1(grp,qnum,kno,keyo,varo,como,tago,sort2,dir) ; for each grouped attribute 109 | s keyo=keyo_como_varo,como="," 110 | s tago=%z("dl")_%z("pt")_qnum_"o"_kno_%z("dl") 111 | s %zq("tagp")=$s(kno=1:$s(sort2:%z("dl")_%z("pt")_qnum_"on2"_%z("dl"),1:%zq("tagout")),kno>1:%z("dl")_%z("pt")_qnum_"o"_(kno-1)_%z("dl"),1:"") 112 | s line=tag_" s "_varo_"="_"$o("_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_"),"_dir_") i "_varo_"=""""" 113 | i kno=1,qnum'=1 s line=line_" q" d addline^%mgsqlc(grp,.line) q 114 | s line=line_" g "_%zq("tagp") d addline^%mgsqlc(grp,.line) 115 | q 116 | ; 117 | sort2(grp,qnum,keyo) ; perform secondary sort 118 | n i,x,y,keyn,keyx,varx,com,dir 119 | s line=" ; secondary sort" d addline^%mgsqlc(grp,.line) 120 | s line=" m "_%z("vdata")_"="_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_keyo_")" d addline^%mgsqlc(grp,.line) 121 | s (keyn,com)="" f i=1:1 q:'$d(^mgtmp($j,"order",i)) d 122 | . s x=$g(^mgtmp($j,"order",i,0)),y=$p(x,"~",1) i y="" s y=1 123 | . s keyn=keyn_com_"$s("_%z("vdata")_"("_y_")"_"="""":"" "",1:"_%z("vdata")_"("_y_")"_")",com="," 124 | . q 125 | s line=" s "_%z("pv")_"n="_%z("pv")_"n+1" d addline^%mgsqlc(grp,.line) 126 | s line=" m "_%z("ctg")_"("_%z("cts")_","_"""x2"","_qnum_","_keyn_","_%z("pv")_"n)="_%z("vdata") d addline^%mgsqlc(grp,.line) 127 | s line=" g "_tag d addline^%mgsqlc(grp,.line) 128 | s line=%z("dl")_%z("pt")_qnum_"on2"_%z("dl")_" ; secondary sort output" d addline^%mgsqlc(grp,.line) ;_" s ("_keyo_","_%z("pv")_"n)=""""" d addline^%mgsqlc(grp,.line) 129 | s (keyx,com)="" f i=1:1 q:'$d(^mgtmp($j,"order",i)) d 130 | . s x=$g(^mgtmp($j,"order",i,0)) 131 | . s varx=%z("dsv")_"__order"_$p(x,"~",1)_%z("dsv") 132 | . s dir=$p(x,"~",2),dir=$s(dir="desc":-1,1:1) 133 | . s keyx=keyx_com_varx,com="," 134 | . s tag=%z("dl")_%z("pt")_qnum_"on2"_i_%z("dl") 135 | . s %zq("tagp")=$s(i=1:%zq("tagout"),i>1:%z("dl")_%z("pt")_qnum_"on2"_(i-1)_%z("dl"),1:"") 136 | . s line=" s "_varx_"=""""" d addline^%mgsqlc(grp,.line) 137 | . s line=tag_" s "_varx_"="_"$o("_%z("ctg")_"("_%z("cts")_","_"""x2"","_qnum_","_keyx_"),"_dir_")"_" i "_varx_"=""""" 138 | . i i=1,qnum'=1 s line=line_" q" d addline^%mgsqlc(grp,.line) q 139 | . s line=line_" g "_%zq("tagp") d addline^%mgsqlc(grp,.line) 140 | . q 141 | s line=" s "_%z("pv")_"n=""""" d addline^%mgsqlc(grp,.line) 142 | s tag=%z("dl")_%z("pt")_qnum_"on2"_(i)_%z("dl"),%zq("tagp")=%z("dl")_%z("pt")_qnum_"on2"_(i-1)_%z("dl") 143 | s line=tag_" s "_%z("pv")_"n=$o("_%z("ctg")_"("_%z("cts")_","_"""x2"","_qnum_","_keyx_","_%z("pv")_"n))"_" i "_%z("pv")_"n="""" g "_%zq("tagp") d addline^%mgsqlc(grp,.line) 144 | s keyo=keyx_","_%z("pv")_"n" 145 | q 146 | ; 147 | row(grp,qnum,havezo,codezo) ; output a line of sql data 148 | n outsel,i 149 | s line=line_" s "_%z("vrc")_"="_%z("vrc")_"+1" d addline^%mgsqlc(grp,.line) 150 | i codezo'="" s line=codezo d addline^%mgsqlc(grp,.line) 151 | i $d(^mgtmp($j,"upd")) q 152 | i 'havezo d 153 | . s outsel=^mgtmp($j,"outsel",qnum) 154 | . f i=1:1:outsel s line=line_" s %zo("_%z("vrc")_","_i_")="_^mgtmp($j,"outsel",qnum,i) d addline^%mgsqlc(grp,.line) 155 | . q 156 | s line=line_" s "_%z("vok")_"=$$ss^%mgsqlz(.%zi,.%zo,"_%z("vrc")_") i "_%z("vok")_" g "_%zq("tagx") d addline^%mgsqlc(grp,.line) 157 | q 158 | ; 159 | top(grp,qnum,sort) ; sql top 160 | n top 161 | s top=$g(^mgtmp($j,"sel",qnum,0)) i top'?1"top#"1n.n q 162 | s top=$p(top,"#",2) 163 | i sort s line=" i "_%z("vrc")_"'<"_top_" g "_%zq("tagout") d addline^%mgsqlc(grp,.line) 164 | i 'sort s line=" i "_%z("vrc")_"'<"_top_" g "_%zq("tagx") d addline^%mgsqlc(grp,.line) 165 | q 166 | ; 167 | -------------------------------------------------------------------------------- /yottadb/_mgsqlc4.m: -------------------------------------------------------------------------------- 1 | %mgsqlc4 ;(CM) sql compiler - restrictions ; 28 Jan 2022 9:58 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlc4") q 26 | ; 27 | pre(dbid,qnum,tnum,item,data,dir,got,cond) ; preset subscript and determine stop condition(s) 28 | n i,preop,postop,sqlv,cname,op,other,link 29 | s dir=$g(dir(item)) i dir="" s dir=1 30 | s preop=$s(dir=-1:":=:']:<:'>:",1:":=:]:>:'<:") 31 | s postop=$s(dir=-1:":=:]:>:'<:",1:":=:']:<:'>:") 32 | s sqlv=$p(item,%z("dsv"),2),cname=$p(sqlv,".",2) 33 | s link="" f s link=$o(^mgtmp($j,"pre",qnum,item,link)) q:link="" d 34 | . f i=1:1 q:'$d(^mgtmp($j,"pre",qnum,item,link,i)) d 35 | . . s op=^mgtmp($j,"pre",qnum,item,link,i,"op"),other=^mgtmp($j,"pre",qnum,item,link,i,"cnst") 36 | . . s line="" 37 | . . d pre1(dbid,qnum,tnum,item,op,other,link,.got,.cond,preop,postop) 38 | . . ;d addpre(qnum,line,item,op,other,link,type,0,.cond) 39 | . . q 40 | . q 41 | prex s link="" f s link=$o(cond(item,"post",link)) q:link="" i '$d(cond(item,"pre",link)) s cond(item,"pre",link)=" "_"s"_" "_item_"=""""",cond(item,"pre","nostrt")="" 42 | i '$d(cond(item,"pre",1)) s cond(item,"pre",1)=" "_"s"_" "_item_"=""""",cond(item,"pre","nostrt")="" i $d(cond(item,"pre",2)) s cond(item,"pre",1)=cond(item,"pre",2) k cond(item,"pre",2) 43 | k cond(item,"link") 44 | q 45 | ; 46 | pre1(dbid,qnum,tnum,item,op,other,link,got,cond,preop,postop) ; evaluate restriction 47 | n type,mtype 48 | s line="" 49 | i '$$dep(qnum,line,item,op,other,.got) q 50 | i op="=" s line=" "_"s"_" "_item_op_other d addpre(qnum,line,item,op,other,link,"pre",1,.cond) q 51 | i postop[(":"_op_":") g pre2 52 | ; pre condition 53 | s line=$$preset(dbid,qnum,tnum,item,op,other) 54 | d addpre(qnum,line,item,op,other,link,"pre",0,.cond) 55 | q 56 | pre2 ; post condition 57 | s line=$$post(dbid,qnum,tnum,item,op,other) 58 | d addpre(qnum,line,item,op,other,link,"post",0,.cond) 59 | q 60 | ; 61 | preset(dbid,qnum,tnum,item,op,other) ; set up starting point for subscript 62 | s line="" 63 | i op=">"!(op="<") s line=" "_"s"_" "_item_"="_other q line 64 | i op="]" s line=" "_"s"_" "_item_"="_other q line 65 | s mtype=$$mtype(dbid,qnum,tnum,item,other) 66 | s ^mgtmp($j,"mtype",other)=mtype 67 | i op="'<",mtype="str" d q line 68 | . i other?.1"-".n.1"."1n.n s line=" "_"s"_" "_item_"="_other_"-0.00001" q 69 | . s line=" "_"s"_" "_item_"="_$e(other,1,$l(other)-2)_$c($a(other,$l(other)-1)-1)_$c(34) q 70 | . q 71 | i op="'<",mtype="num" s line=" "_"s"_" "_item_"="_other_"-0.00001" q line 72 | i op="'<",mtype="var" s line=" "_"s"_":"_other_"?.1""-"".n.1"".""1n.n "_item_"="_other_"-0.00001 "_"s"_":"_other_"'?.1""-"".n.1"".""1n.n "_item_"="_"$e"_"("_other_",1,"_"$l"_"("_other_")-1)_"_"$c"_"("_"$a"_"("_"$e"_"("_other_","_"$l"_"("_other_")))-1)_""~""" q line 73 | i op="']"!(op="'>"),mtype="str" s line=" "_"s"_" "_item_"="_$e(other,1,$l(other)-2)_$c($a(other,$l(other)-1)+1)_$c(34) q line 74 | i op="']"!(op="'>"),mtype="num" s line=" "_"s"_" "_item_"="_other_"+0.00001" q line 75 | i op="']"!(op="'>"),mtype="var" s line=" "_"s"_":"_other_"?.1""-"".n.1"".""1n.n "_item_"="_other_"+0.00001 "_"s"_":"_other_"'?.1""-"".n.1"".""1n.n "_item_"="_"$e"_"("_other_",1,"_"$l"_"("_other_")-1)_"_"$c"_"("_"$a"_"("_"$e"_"("_other_","_"$l"_"("_other_")))+1)" q line 76 | q line 77 | ; 78 | post(dbid,qnum,tnum,item,op,other) ; set up stop condition for subscript 79 | s line="" 80 | s mtype=$$mtype(dbid,qnum,tnum,item,other) 81 | s ^mgtmp($j,"mtype",other)=mtype 82 | i mtype="str" s line=" "_"i"_" "_$s(op="<":item_"="_other_"!("_item_"]"_other_")",op="'>":item_"]"_other,op="']":item_"]"_other,op=">":item_"']"_other,op="]":item_"']"_other,op="'<":item_"'="_other_","_item_"']"_other,1:"") q line 83 | i mtype="num" s line=" "_"i"_" "_$s(op="<":item_"'<"_other,op="'>":item_">"_other,op="']":item_"="_other_"!("_item_"]"_other_")",op=">":item_"'>"_other,op="]":item_"'>"_other,op="'<":item_"'="_other_","_item_"'>"_other,1:"") q line 84 | i mtype="var",op="]"!(op=">") s line=" "_"k"_" %s "_"s"_" %s("_item_")="""",%xx="_"$o"_"(%s("_other_")) "_"k"_" %s "_"i"_" %xx'="_item q line 85 | i mtype="var",op="'<" s line=" "_"i"_" "_"$l"_"("_other_") "_"k"_" %s "_"s"_" %s("_item_")="""",%xx="_"$o"_"(%s("_other_"),-1) "_"k"_" %s "_"i"_" %xx="_item q line 86 | i mtype="var",op="<" s line=" "_"k"_" %s "_"s"_" %s("_item_")="""",%xx="_"$o"_"(%s("_other_"),-1) "_"k"_" %s "_"i"_" %xx'="_item q line 87 | i mtype="var",op="']"!(op="'>") s line=" "_"i"_" "_"$l"_"("_other_") "_"k"_" %s "_"s"_" %s("_item_")="""",%xx="_"$o"_"(%s("_other_")) "_"k"_" %s "_"i"_" %xx="_item q line 88 | q line 89 | ; 90 | dep(qnum,line,item,op,other,got) ; look for (bad) dependencies and bind sub-queries if necessary 91 | n i,sqvar,qnum1,subvar,ok 92 | s ok=1 93 | f i=2:2 s sqvar=$p(other,%z("dsv"),i) q:sqvar="" s ok=$$got(qnum,sqvar,.got) i 'ok q 94 | i 'ok q 0 95 | f q:other'[%z("dq") s qnum1=$p(other,%z("dq"),2) s ok=$$gotsq(qnum,qnum1,.got,.subvar) q:'ok s other=$p(other,%z("dq"),1)_subvar_$p(other,%z("dq"),3,999) 96 | i 'ok q 0 97 | q 1 98 | ; 99 | got(qnum,sqvar,got) ; check that data restricted upon is available 100 | n alias,cname 101 | s alias=$p(sqvar,".",1),cname=$p(sqvar,".",2) 102 | i alias="" q 1 103 | i qnum>1,'$d(^mgtmp($j,"from","x",qnum,alias)) q 1 ; coorelated sq, must be ok 104 | i '$d(got("f",alias)),'$d(got("a",sqvar)) q 0 105 | q 1 106 | ; 107 | gotsq(qnum,qnum1,got,subvar) ; look for availability of data from subquery 108 | n alias1,sqvar1,notgot,cmax,x,ok 109 | s subvar="" 110 | s cmax=0,x="" f s cmax=$o(^mgtmp($j,"corel",qnum,x)) q:x="" s cmax=x 111 | i cmax>0,qnum1=cmax,^mgtmp($j,"corel",qnum,qnum1)'=1 q 0 112 | s alias1="" f s alias1=$o(^mgtmp($j,"corel",qnum,qnum1,alias1)) q:alias1="" i '$d(got("f",alias1)) s notgot(alias1)="" 113 | s alias1="" f s alias1=$o(notgot(alias1)) q:alias1=""!'ok d 114 | . s sqvar1="" 115 | . f s sqvar1=$o(^mgtmp($j,"corel",qnum,qnum1,alias1,sqvar1)) q:sqvar1="" i '$d(got("a",sqvar1)) s ok=0 q 116 | . q 117 | i 'ok q 0 118 | s subvar=^mgtmp($j,"sel",qnum1,1) 119 | q 1 120 | ; 121 | addpre(qnum,line,item,op,other,link,type,fixed,cond) ; add line of code to subscript initialisation array 122 | n ln 123 | i line="" q 124 | s ^mgtmp($j,"wexcl",qnum,item_op_other)="",^(other_op_item)="" 125 | i '$d(cond(item)) s cond(item)=0 126 | i '$d(cond(item,"link",link)) s ln=$i(cond(item)),cond(item,"link",link)=ln 127 | s ln=cond(item,"link",link) 128 | s cond(item,type,ln)=line 129 | i fixed s cond(item,"fixed",ln)="" 130 | q 131 | ; 132 | mtype(dbid,qnum,tnum,item,other) ; determine sort of data 133 | n %d,tname,cname,mtype 134 | s %d=^mgtmp($j,"from",qnum,tnum) 135 | s tname=$p(%d,"~",1) 136 | s cname=$p($p(item,%z("dsv"),2),".",2) 137 | s %d=$$col^%mgsqld(dbid,tname,cname) s mtype=$p(%d,"\",11) 138 | i mtype'="",other[%z("dev"),mtype="str" s mtype="var" q mtype 139 | i other?1"""".e s mtype="str" q mtype 140 | i other?.1"-".n.1"."1n.n s mtype="num" q mtype 141 | s mtype="var" 142 | q mtype 143 | ; 144 | -------------------------------------------------------------------------------- /yottadb/_mgsqlc5.m: -------------------------------------------------------------------------------- 1 | %mgsqlc5 ;(CM) sql compiler - get data ; 28 Jan 2022 9:58 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlc5") q 26 | ; 27 | keyidx(qnum,tnum) ; file key for index 28 | n y,z,i 29 | s y=$g(data(qnum,tnum,"pkey")) i y="" q 30 | f i=1:1:$l(y,",") s z=$p($p(y,",",i),%z("dsv"),2) i z'="" s ^mgtmp($j,"get",z)="" 31 | q 32 | ; 33 | data(grp,qnum,tnum,data,got,error) ; retrieve required data from file 34 | n col,pkey,zglo,zgloz,zkey,subt,fail,col 35 | s pkey=data(qnum,tnum,"pkey") 36 | d keyidx(qnum,tnum) 37 | i $g(^mgtmp($j,"dontgetdata",qnum,tnum))=1 q 38 | i $d(^mgtmp($j,"from","z",qnum,"pass",alias)) d ojoinda^%mgsqlc1(grp,qnum,tnum,.data,.error) 39 | s zglo=data(qnum,tnum,"pglo"),zgloz=$s(zglo[%z("dev"):""")",1:"") 40 | s zkey=data(qnum,tnum,"pkey") 41 | s subt="" i qnum=1,$g(^mgtmp($j,"unique",1))=2 s subt=%z("vdef") 42 | i $d(data(qnum,tnum,"col")) s fail=$s($d(%zq("tag",qnum)):" g "_%zq("tag",qnum),1:"") d g^%mgsqlci(grp,subt,%z("vdata"),zglo,zkey,zgloz) 43 | s col="" f s col=$o(data(qnum,tnum,"col",col)) q:col="" d data1(grp,qnum,tnum,col,%z("vdata"),.data,.error) 44 | i $d(^mgtmp($j,"from","z",qnum,"pass",alias)) d ojoindz^%mgsqlc1(grp,qnum,tnum,.data,.error) 45 | d corelate(grp,qnum,.got) 46 | q 47 | ; 48 | data1(grp,qnum,tnum,col,dstr,data,error) ; retrieve data item or just check if in parsed index 49 | n sm,ssubs,pce,fail,pkey,pglo,key,subt,ssubs,derv 50 | s ^mgtmp($j,"get",col)="" 51 | s pkey=data(qnum,tnum,"pkey"),pglo=data(qnum,tnum,"pglo") 52 | s subt="" i qnum=1,$g(^mgtmp($j,"unique",1))=2 s subt=%z("vdef") 53 | i $l(col,".")>2 s col=$p(col,".",1,2) i $d(data(qnum,tnum,"col",col))#10 q 54 | i data(qnum,tnum,"pkey")[(%z("dsv")_col_%z("dsv")) q ; primary key 55 | s pce=$p(data(qnum,tnum,"col",col),"\",1),sm=$p(data(qnum,tnum,"col",col),"\",3) 56 | s ssubs=$g(data(qnum,tnum,"col",col,"s")),derv=$g(data(qnum,tnum,"col",col,"d")) 57 | i derv'="" d derv(grp,qnum,tnum,col,dstr,derv,.data,.error) q 58 | i pce="" s line=" s "_%z("dsv")_col_%z("dsv")_"=""""" g data1x 59 | i sm="d",$l(data(qnum,tnum,"dlm")) s line="$p"_"("_dstr_","_data(qnum,tnum,"dlm")_","_pce_")" 60 | i sm="d",'$l(data(qnum,tnum,"dlm")) s line=dstr 61 | i sm="s",$l(subt) s line=" s %ds=""""" d addline^%mgsqlc(grp,.line) 62 | i sm="s" s key=pkey_","_ssubs,dat="%ds",fail="" d g^%mgsqlci(grp,subt,dat,pglo,key,"") s line="%ds" 63 | i pkey[(%z("dsv")_col_%z("dsv")) s line=" "_"i"_" "_line_"'="_%z("dsv")_sqat_%z("dsv")_" "_"s"_" ^sqlerr("_$c(34)_tname_$c(34)_","_pkey_")="""" "_"g"_" "_%zq("tag",qnum) 64 | i pkey'[(%z("dsv")_col_%z("dsv")) s line=" "_"s"_" "_%z("dsv")_col_%z("dsv")_"="_line 65 | data1x d addline^%mgsqlc(grp,.line) 66 | q 67 | ; 68 | derv(grp,qnum,tnum,col,dstr,derv,data,error) ; derived column 69 | n %d,tname,alias,cn,pn,cname,ex,outv,word,zcode,fun,arg 70 | s %d=^mgtmp($j,"from",qnum,tnum) 71 | s tname=$p(%d,"~",1),alias=$p(%d,"~",2) 72 | s ex(1)="$$"_derv d ex^%mgsqle(col,.ex,.word,.zcode,.fun,.error) i $l(error) q 73 | f cn=1:1 q:'$d(zcode(cn)) f pn=4:2 s cname=$p(zcode(cn),%z("dsv"),pn) q:cname="" d 74 | . s arg=alias_"."_cname 75 | . s $p(zcode(cn),%z("dsv"),pn)=arg 76 | . i '$d(^mgtmp($j,"get",arg)) d data1(grp,qnum,tnum,arg,dstr,.data,.error) 77 | . q 78 | f cn=1:1 q:'$d(zcode(cn)) s line=zcode(cn) d addline^%mgsqlc(grp,.line) 79 | q 80 | ; 81 | corelate(grp,qnum,got) ; provide calls to correlated sub-queries 82 | n i,alias,ok,notgot,qnum1,com,sqvar,line,cmax,x 83 | s qnum1="",line="",com="" 84 | f s qnum1=$o(^mgtmp($j,"corel",qnum,qnum1)) q:qnum1="" d 85 | . i ^mgtmp($j,"corel",qnum,qnum1) q 86 | . s alias="" f s alias=$o(^mgtmp($j,"corel",qnum,qnum1,alias)) q:alias="" i '$d(got("f",alias)) s notgot(alias)="" 87 | . s ok=1 s alias="" f s alias=$o(notgot(alias)) q:alias=""!'ok s sqvar="" f s sqvar=$o(^mgtmp($j,"corel",qnum,qnum1,alias,sqvar)) q:sqvar="" i '$d(got("a",sqvar)) s ok=0 q 88 | . i 'ok q 89 | . s cmax=0,x="" f s x=$o(^mgtmp($j,"corelx",qnum1,x)) q:x="" s cmax=x 90 | . i cmax>0,qnum'=cmax q 91 | . s line=%z("dl")_%z("pt")_qnum1_"s"_%z("dl")_com_line,com=",",^mgtmp($j,"corel",qnum,qnum1)=1 92 | . q 93 | i $l(line) s line=" d "_line d addline^%mgsqlc(grp,.line) 94 | q 95 | ; 96 | crind(grp,qnum) ; create required index 97 | n %def,%ind,%ref,r,tname,alias,ref,x,xd,test,comr,comt,idx,ino,sc 98 | s r=^mgtmp($j,"create","index"),tname=$p(r,"~",1),idx=$p(r,"~",2) 99 | s alias=$p(tname," ",2),tname=$p(tname," ",1) 100 | s ino=idx s %ref=$$ref^%mgsqld(dbid,tname,ino) s ref=%ref_"(",test="",comr="",comt="" 101 | s ino=idx s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) f i=1:1 q:'$d(%ind(idx,i)) d 102 | . s (cname,xd)=%ind(idx,i) 103 | . k %ind(idx,i) 104 | . i cname?1a.e s xd=%z("dsv")_alias_"."_cname_%z("dsv") 105 | . s ref=ref_comr_xd,comr="," 106 | . i xd[%z("dsv") s ino=$$pkey^%mgsqld(dbid,tname) s %def=$$defkdi^%mgsqld(dbid,tname,cname,ino) i '%def s test=test_comt_"$l("_xd_")",comt="," 107 | . q 108 | i $l(test) s line=" i "_test 109 | s line=line_" s "_ref_")=""""" d addline^%mgsqlc(grp,.line) 110 | s line=" g "_%zq("tag",qnum) d addline^%mgsqlc(grp,.line) 111 | q 112 | ; 113 | klind(grp,qnum) ; kill off index to be created 114 | k %ind,%ref,r,tname,alias,idx,x,com,ino,i 115 | s r=^mgtmp($j,"create","index"),tname=$p(r,"~",1),idx=$p(r,"~",2) 116 | s alias=$p(tname," ",2),tname=$p(tname," ",1) 117 | s line="",com="" 118 | s ino=idx s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) f i=1:1 q:'$d(%ind(idx,i)) s x=%idx(idx,i) k %idx(idx,i) q:x?1a.e s line=line_com_x,com="," 119 | i $l(line) s line="("_line_")" 120 | s ino=idx s %ref=$$ref^%mgsqld(dbid,tname,ino) s line=" k "_%ref_line d addline^%mgsqlc(grp,.line) 121 | q 122 | ; 123 | -------------------------------------------------------------------------------- /yottadb/_mgsqlc6.m: -------------------------------------------------------------------------------- 1 | %mgsqlc6 ;(CM) sql compiler - aggregates ; 28 Jan 2022 9:58 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlc6") q 26 | ; 27 | aginit(grp,qnum,tnum) ; initialise select functions on data attributes 28 | n ag,item,kdist 29 | i qnum=1,$g(^mgtmp($j,"unique",1))=3 d init(grp,qnum) 30 | i $d(^mgtmp($j,"ktmp",qnum)) s line=" k "_%z("ctg")_"("_%z("cts")_","_qnum_")" d addline^%mgsqlc(grp,.line) 31 | i $d(^mgtmp($j,"group",qnum)) s ^mgtmp($j,"ktmp")=1,line=" k "_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_")" d addline^%mgsqlc(grp,.line) q 32 | s kdist=0 33 | s item="" f s item=$o(^mgtmp($j,"sqag",qnum,item)) q:item="" s ag="" f s ag=$o(^mgtmp($j,"sqag",qnum,item,ag)) q:ag="" d aginit1(grp,qnum,tnum,item,ag,.kdist) 34 | q 35 | ; 36 | aginit1(grp,qnum,tnum,item,ag,kdist) ; generate line of code to initilalise each specific aggregate 37 | n sqvar,agtyp,notnull 38 | s agtyp=$p(ag,"_",1) 39 | s notnull=0 i $p(ag,"_",2)="notnull" s notnull=1 40 | s sqvar=%z("dsv")_ag_"("_item_")"_%z("dsv") 41 | i agtyp="count" s:item'["*" line=line_" s "_%z("dsv")_ag_"("_item_")"_%z("dsv")_"=0" i item["*" s line=line_" s "_sqvar_"=0" 42 | i agtyp="cntd",item'["*",qnum'=1,'kdist s kdist=1,line=" k "_%z("ctg")_"("_%z("cts")_","_"""d"","_qnum_")" d addline^%mgsqlc(grp,.line) 43 | i agtyp="cntd",item'["*" s line=" s "_%z("dsv")_"cntd("_item_")"_%z("dsv")_"=0" d addline^%mgsqlc(grp,.line) 44 | i agtyp="sum" s line=line_" s "_%z("dsv")_ag_"("_item_")"_%z("dsv")_"=0" 45 | i agtyp="avg" s line=line_" s "_%z("dsv")_ag_"avsum("_item_")"_%z("dsv")_"=0,"_%z("dsv")_ag_"avcnt("_item_")"_%z("dsv")_"=0" 46 | i agtyp="max" s line=line_" s "_%z("dsv")_ag_"("_item_")"_%z("dsv")_"=""""" 47 | i agtyp="min" s line=line_" s "_%z("dsv")_ag_"("_item_")"_%z("dsv")_"="""","_%z("dsv")_ag_"nullindata("_item_")"_%z("dsv")_"=0" 48 | d addline^%mgsqlc(grp,.line) 49 | q 50 | ; 51 | updfun ; update aggregates 52 | s ordsub="" 53 | i $d(^mgtmp($j,"group",qnum)) d ggroup 54 | s x="" f s x=$o(^mgtmp($j,"sqag",qnum,x)) q:x="" s fun="" f s fun=$o(^mgtmp($j,"sqag",qnum,x,fun)) q:fun="" d updfun1 55 | i $d(^mgtmp($j,"group",qnum)) d ugroup 56 | k gvaru 57 | q 58 | ; 59 | updfun1 ; generate line of code to update specific aggregate 60 | n z,funtyp,nulltest 61 | i $d(^mgtmp($j,"ktmp",qnum)) s line=" k "_%z("ctg")_"("_%z("cts")_","_qnum_")" d addline^%mgsqlc(grp,.line) 62 | s funtyp=$p(fun,"_",1),nulltest="" i $p(fun,"_",2)="notnull" s nulltest=" "_"i"_" $l("_%z("dsv")_x_%z("dsv")_")" 63 | s z=%z("dsv")_fun_"("_x_")"_%z("dsv") 64 | ; 65 | i funtyp="count",$d(index(0,alias,"a")) s nulltest="" 66 | ; 67 | i funtyp="count",$d(index(0,alias,"a")) s line=nulltest_" "_"s"_" "_z_"="_z_"+"_%z("dsv")_x_%z("dsv") d addline^%mgsqlc(grp,.line) q 68 | i funtyp="count",x'["*" s line=nulltest_" "_"s"_" "_z_"="_z_"+1" d addline^%mgsqlc(grp,.line) q 69 | i funtyp="count",x["*" s line=" "_"s"_" "_z_"="_z_"+1" d addline^%mgsqlc(grp,.line) q 70 | i funtyp="cntd",x'["*" s ^mgtmp($j,"ktmp")=1 71 | i funtyp="cntd",x'["*" d cntd q 72 | i funtyp="sum" s line=nulltest_" "_"s"_" "_z_"="_z_"+"_%z("dsv")_x_%z("dsv") d addline^%mgsqlc(grp,.line) q 73 | i funtyp="avg" s line=nulltest_" "_"s"_" "_%z("dsv")_fun_"avcnt("_x_")"_%z("dsv")_"="_%z("dsv")_fun_"avcnt("_x_")"_%z("dsv")_"+1,"_%z("dsv")_fun_"avsum("_x_")"_%z("dsv")_"="_%z("dsv")_fun_"avsum("_x_")"_%z("dsv")_"+"_%z("dsv")_x_%z("dsv")_","_z_"="_%z("dsv")_fun_"avsum("_x_")"_%z("dsv")_"/"_%z("dsv")_fun_"avcnt("_x_")"_%z("dsv") d addline^%mgsqlc(grp,.line) 74 | i funtyp="max" s line=nulltest_" "_"k"_" %s s:$l("_%z("dsv")_x_%z("dsv")_") %s("_%z("dsv")_x_%z("dsv")_")="""" s:$l("_z_") %s("_z_")="""" s "_z_"=$o(%s(""""),-1) k %s" d addline^%mgsqlc(grp,.line) q 75 | i funtyp="min" s line=nulltest_" s:'$l("_%z("dsv")_x_%z("dsv")_") "_z_"="""","_%z("dsv")_fun_"nullindata("_x_")"_%z("dsv")_"=1 i '"_%z("dsv")_fun_"nullindata("_x_")"_%z("dsv")_" k %s s %s("_%z("dsv")_x_%z("dsv")_")="""" s:$l("_z_") %s("_z_")="""" s "_z_"=$o(%s("""")) k %s" d addline^%mgsqlc(grp,.line) q 76 | i $d(^mgtmp($j,"group",qnum)) q 77 | q 78 | ; 79 | cntd ; count distinct 80 | n tag,notnullx 81 | s notnullx="" i $l(nulltest) s notnullx="{notnull}" 82 | s tag=%z("dl")_%z("pt")_"cntd"_notnullx_x_%z("dl") 83 | i $l(nulltest) s line=" i '$l("_%z("dsv")_x_%z("dsv")_") g "_tag d addline^%mgsqlc(grp,.line) 84 | s ref=%z("ctg")_"("_%z("cts")_","_"""d"","_qnum_$s($l(ordsub):","_ordsub,1:"")_","_""""_%z("dsv")_notnullx_x_%z("dsv")_""""_","_%z("dsv")_x_%z("dsv")_")" 85 | s line=" s:'$l("_%z("dsv")_x_%z("dsv")_") "_%z("dsv")_x_%z("dsv")_"="" "" i $d("_ref_") g "_tag d addline^%mgsqlc(grp,.line) 86 | s line=" s "_ref_"=""""" d addline^%mgsqlc(grp,.line) 87 | s line=" s "_%z("dsv")_fun_"("_x_")"_%z("dsv")_"="_%z("dsv")_fun_"("_x_")"_%z("dsv")_"+1" d addline^%mgsqlc(grp,.line) 88 | s line=tag_" ;" d addline^%mgsqlc(grp,.line) 89 | q 90 | ; 91 | ggroup ; retrieve data for current update on 'grouped' items 92 | k gvaru s gvaru=0 93 | s tk0=""",""""x"""","_qnum 94 | s ordsub="",com="" 95 | f i=1:1 q:'$d(^mgtmp($j,"group",qnum,i)) d 96 | . s x=$g(^mgtmp($j,"group",qnum,i)) ;,y=%z("dsv")_"__order"_$p(^mgtmp($j,"order",i,0),"~",1)_%z("dsv") 97 | . s ordsub=ordsub_com_"$s("_x_"="""":"" "",1:"_x_")",com="," 98 | . q 99 | s line=" k "_%z("vdata")_" m "_%z("vdata")_"="_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_ordsub_")" d addline^%mgsqlc(grp,.line) 100 | s x="" f s x=$o(^mgtmp($j,"sqag",qnum,x)) q:x="" s fun="" f s fun=$o(^mgtmp($j,"sqag",qnum,x,fun)) q:fun="" d ggroup1 101 | k rec0,rec 102 | q 103 | ; 104 | ggroup1 ; retrieve data for specific function 105 | n z,ref,funtyp 106 | s funtyp=$p(fun,"_",1) 107 | s z=%z("dsv")_fun_"("_x_")"_%z("dsv") 108 | s line=" s "_%z("vdatax")_"=$g("_%z("vdata")_"("_^mgtmp($j,"sqag",qnum,x,fun)_"))" d addline^%mgsqlc(grp,.line) 109 | i funtyp="count"!(funtyp="cntd")!(funtyp="sum")!(funtyp="max") s line=" s "_z_"="_%z("vdatax")_" i "_z_"="""" s "_z_"=0" 110 | i funtyp="avg" s line=" s:"_%z("vdatax")_"'="""" "_%z("dsv")_fun_"avcnt("_x_")"_%z("dsv")_"=$p("_%z("vdatax")_",""#"",2),"_%z("dsv")_fun_"avsum("_x_")"_%z("dsv")_"=$p("_%z("vdatax")_",""#"",3) s:"_%z("vdatax")_"="""" "_%z("dsv")_fun_"avcnt("_x_")"_%z("dsv")_"=0,"_%z("dsv")_fun_"avsum("_x_")"_%z("dsv")_"=0" 111 | i funtyp="min" s line=" s:"_%z("vdatax")_"'="""" "_z_"=$p("_%z("vdatax")_",""#"",1),"_%z("dsv")_fun_"nullindata("_x_")"_%z("dsv")_"=$p("_%z("vdatax")_",""#"",2) s:"_%z("vdatax")_"="""" "_z_"="""","_%z("dsv")_fun_"nullindata("_x_")"_%z("dsv")_"=0" 112 | d addline^%mgsqlc(grp,.line) 113 | q 114 | ; 115 | ugroup ; update goups 116 | f i=1:1 q:'$d(^mgtmp($j,"outsel",qnum,i)) s x=^(i) d 117 | . i x[%z("dsv")&(x["(")&$d(^mgtmp($j,"group",qnum)) s x=0 118 | . s line=" s "_%z("vdata")_"("_i_")="_x 119 | . d addline^%mgsqlc(grp,.line) ;s recc=recc_rdelc_x,rdelc="_"_$c(34)_"~"_$c(34)_"_" d outrec1 120 | . q 121 | s x="" f s x=$o(^mgtmp($j,"sqag",qnum,x)) q:x="" s fun="" f s fun=$o(^mgtmp($j,"sqag",qnum,x,fun)) q:fun="" d ugroup1 122 | s line=" ; set the record" d addline^%mgsqlc(grp,.line) 123 | s line=" m "_%z("ctg")_"("_%z("cts")_","_"""x"","_qnum_","_ordsub_")="_%z("vdata") d addline^%mgsqlc(grp,.line) 124 | q 125 | ; 126 | ugroup1 ; update group for specific function 127 | n funtyp,z 128 | s funtyp=$p(fun,"_",1) 129 | s z=%z("dsv")_fun_"("_x_")"_%z("dsv") 130 | i funtyp="count"!(funtyp="cntd")!(funtyp="sum")!(funtyp="max") s line=" s "_%z("vdata")_"("_^mgtmp($j,"sqag",qnum,x,fun)_")="_z 131 | i funtyp="min" s line=" s "_%z("vdata")_"("_^mgtmp($j,"sqag",qnum,x,fun)_")="_z_"_""#""_"_%z("dsv")_fun_"nullindata("_x_")"_%z("dsv") 132 | i funtyp="avg" s line=" s "_%z("vdata")_"("_^mgtmp($j,"sqag",qnum,x,fun)_")="_z_"_""#""_"_%z("dsv")_fun_"avcnt("_x_")"_%z("dsv")_"_""#""_"_%z("dsv")_fun_"avsum("_x_")"_%z("dsv") 133 | d addline^%mgsqlc(grp,.line) 134 | q 135 | ; 136 | init(grp,qnum) ; initialise select statement for unique queries 137 | n line,outsel,com,i,x 138 | s outsel=^mgtmp($j,"outsel") 139 | s (line,com)="" f i=1:1:outsel s x=^mgtmp($j,"sel",qnum,i) i x[%z("dsv"),x'["(" s line=line_com_x,com="," i $l(line)>200 s line=" s ("_line_")=""""",com="" d addline^%mgsqlc(grp,.line) 140 | i $l(line) s line=" s ("_line_")=""""" d addline^%mgsqlc(grp,.line) 141 | q 142 | ; 143 | -------------------------------------------------------------------------------- /yottadb/_mgsqlcd.m: -------------------------------------------------------------------------------- 1 | %mgsqlcd ;(CM) sql compiler - delete ; 28 Jan 2022 9:59 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlcd") q 26 | ; 27 | main ; start 28 | s %tagz=%zq("tag",1) 29 | s tname=^mgtmp($j,"upd","delete"),alias=$p($p(tname," ",2),":",1),tname=$p(tname," ",1) 30 | k dtyp d xfid^%mgsqlct 31 | s line=" "_"k"_" %do,%dn,%dx" d addline^%mgsqlc(grp,.line) 32 | s inop=$$pkey^%mgsqld(dbid,tname) 33 | f i=1:1 q:'$d(xfid(inop,i)) s cname=xfid(inop,i,1) i cname?1a.e d data 34 | s %refile=0 d kill^%mgsqlci 35 | s line=" "_"g"_" "_%tagz d addline^%mgsqlc(grp,.line) 36 | exit ; exit 37 | k upd,key,nkey,nkeyt,okey,okeyt,pkey,pref,idx,apc,cde,z 38 | q 39 | ; 40 | data ; determine values for delete and set r.i. interface 41 | d dtyp^%mgsqlct 42 | s key("o",cname)="%do("_dtyp(cname)_")" 43 | s line=" "_"s"_" "_key("o",cname)_"="_%z("dsv")_alias_"."_cname_%z("dsv") d addline^%mgsqlc(grp,.line) 44 | q 45 | ; 46 | hilev ; kill file off at high level 47 | n n,alias 48 | s tname=$p(^mgtmp($j,"upd","delete")," ",1),alias=$p(^mgtmp($j,"upd","delete")," ",2) i alias="" s alias=tname 49 | s ^mgtmp($j,"sqlupd",tname)="~1" 50 | d xfid^%mgsqlct 51 | s ino="" f i=0:0 s ino=$o(xfid(ino)) q:ino="" d hilev1 52 | hilev3 ; link 53 | s line=" "_"k"_" %do" d addline^%mgsqlc(grp,.line) 54 | s ino=$$pkey^%mgsqld(dbid,tname) f i=1:1 q:'$d(xfid(ino,i)) s cname=xfid(ino,i,1) i cname?1a.e q:'$d(^mgtmp($j,"upd","attx",cname)) s val=^mgtmp($j,"upd","attx",cname),key=key_com_val,com="," i val[%z("dev") s n=$p($$col^%mgsqld(dbid,tname,cname),"\",5) i $l(n) s line=" "_"s"_" %do("_n_")="_val d addline^%mgsqlc(grp,.line) 55 | q 56 | ; 57 | hilev1 ; kill off single index 58 | s (line,key,keyt,com,comt)="" 59 | i ino=$$pkey^%mgsqld(dbid,tname) f i=1:1 q:'$d(xfid(ino,i)) s cname=$g(xfid(ino,i,1)) i cname?1a.e s ^mgtmp($j,"get",alias_"."_cname)="" 60 | f i=1:1 q:'$d(xfid(ino,i)) s cname=xfid(ino,i,1) s:cname'?1a.e key=key_com_cname,com="," i cname?1a.e q:'$d(^mgtmp($j,"upd","attx",cname)) s val=^mgtmp($j,"upd","attx",cname),key=key_com_val,com="," i val[%z("dev") s keyt=keyt_comt_"$l"_"("_val_")",comt="," 61 | i $l(keyt) s line=" "_"i"_" "_keyt 62 | i $l(key) s key="("_key_")" 63 | s line=line_" "_"k"_" "_xfid(ino)_key d addline^%mgsqlc(grp,.line) 64 | q 65 | ; 66 | -------------------------------------------------------------------------------- /yottadb/_mgsqlci.m: -------------------------------------------------------------------------------- 1 | %mgsqlci ;(CM) sql compiler - insert ; 28 Jan 2022 9:59 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlci") q 26 | ; 27 | main ; start 28 | s %tagz=$s('$d(sql(1,1)):%zq("tagout"),1:%zq("tag",1)) 29 | s (tname,alias)=^mgtmp($j,"upd","insert") 30 | k dtyp d xfid^%mgsqlct 31 | f i=1:1 q:'$d(^mgtmp($j,"upd","att",i)) d data 32 | s %refile=1 d set 33 | i $d(sql(1,1)) s line=" "_"g"_" "_%zq("tag",1) d addline^%mgsqlc(grp,.line) 34 | ; 35 | exit ; exit 36 | k upd,null,key,nkey,nkeyt,okey,okeyt,pkey,pref,idx,apc,cde,z 37 | q 38 | ; 39 | data ; determine values for update 40 | s cname=^mgtmp($j,"upd","att",i) 41 | d dtyp^%mgsqlct 42 | s (y,var)=^mgtmp($j,"upd","val",i) 43 | ;i y?.1"."1a.e s var=%z("dsv")_y_%z("dsv") 44 | i y?1":"1a.e s var=%z("dev")_y_%z("dev") 45 | i $d(xfidx(cname)) s (key("o",cname),key("n",cname))=var 46 | i '$d(xfidx(cname)) s dat("n",cname)=var 47 | q 48 | ; 49 | ; key("o",cname)=val : must supply 50 | ; key("n",cname)=val : supply all/partial/none 51 | ; dat("o",cname)=val : optional 52 | ; dat("n",cname)=val : optional 53 | ; %refile : flag for forced refiling of all indices 54 | ; %tagz : label for exit 55 | ; 56 | index ; generate physical index references 57 | s ino="" 58 | index1 s ino=$o(xfid(ino)) i ino="" q 59 | s pst="",typo="o",typn="n" 60 | s (zo,to)="" i %set s (zn,tn,zx,tx)="" 61 | s (com,ando,andn)="" f kno=1:1 q:'$d(xfid(ino,kno)) d index2 s com="," 62 | s pkey("o",ino)=zo,subt("o",ino)=to 63 | i %set s pkey("n",ino)=zn,subt("n",ino)=tn,pkey("x",ino)=zx,subt("x",ino)=tx 64 | g index1 65 | ; 66 | index2 ; process single key element 67 | s zo=zo_com i %set s zn=zn_com,zx=zx_com 68 | s com1="" f ano=1:1 q:'$d(xfid(ino,kno,ano)) d index3 s com1="_"""_","_"""_" 69 | q 70 | ; 71 | index3 ; process a single key attribute 72 | s cname=xfid(ino,kno,ano) 73 | i cname'?1a.e s pvar=cname g index4 74 | i '$d(dtyp(cname)) d dtyp^%mgsqlct 75 | i $d(xfidx(cname)),$d(key(typo,cname)) s pvar=key(typo,cname) g index4 76 | i '$d(dat(typo,cname)) s dat(typo,cname)="%d"_pst_"("_dtyp(cname)_")" 77 | s pvar=dat(typo,cname) 78 | index4 s zo=zo_com1_pvar 79 | i cname?1a.e,'$d(xfidx(cname)) s to=to_ando_"$l"_"("_pvar_")",ando="," 80 | i '%set q 81 | i cname'?1a.e s pvar=cname g index5 82 | i $d(xfidx(cname)) s:'$d(key(typn,cname)) key(typn,cname)=key(typo,cname) s pvar=key(typn,cname) g index5 83 | i '$d(dat(typn,cname)) s dat(typn,cname)=dat(typo,cname) 84 | s pvar=dat(typn,cname) 85 | index5 s xvar=$s(cname?1a.e&'$d(xfidx(cname)):"%dx"_pst_"("_dtyp(cname)_")",1:pvar) 86 | s zn=zn_com1_pvar,zx=zx_com1_xvar 87 | i cname?1a.e,'$d(xfidx(cname)) s tn=tn_andn_"$l"_"("_pvar_")",tx=tx_andn_"$l"_"("_xvar_")",andn="," 88 | q 89 | ; 90 | elim ; eliminate indices not affected by update 91 | s ino=$$pkey^%mgsqld(dbid,tname) f s ino=$o(pkey("n",ino)) q:ino="" i pkey("n",ino)=pkey("o",ino) k pkey("n",ino),pkey("o",ino) 92 | s cname="" f s cname=$o(dat("n",cname)) q:cname="" i $d(dat("o",cname)),dat("n",cname)=dat("o",cname) k dat("n",cname),dat("o",cname) 93 | q 94 | ; 95 | getold ; get old data 96 | n agg,or,getno 97 | k out 98 | k ^mgtmp($j,"got") 99 | s get="y" ;$p(^%mguser("sys"),"~",10) 100 | s line="",or="",cname="" f s cname=$o(key("o",cname)) q:cname="" i cname?1a.e s or(key("o",cname))="",line=line_or_"'"_"$l"_"("_key("o",cname)_")",or="!" 101 | i %set s cname="" f s cname=$o(key("n",cname)) q:cname="" i cname?1a.e,'$d(or(key("n",cname))) s line=line_or_"'"_"$l"_"("_key("n",cname)_")",or="!" 102 | i $l(line) s line=" "_"i"_" "_line_" "_"g"_" "_%tagz d addline^%mgsqlc(grp,.line) 103 | d getold2 104 | s getno=0 105 | s inop=$$pkey^%mgsqld(dbid,tname),ino="" f s ino=$o(pkey("o",ino)) q:ino="" i ino'=inop d getold0 106 | q 107 | ; 108 | getold0 ; get all attibutes involved in indices 109 | f i=1:1 q:'$d(xfid(ino,i)) f ii=1:1 q:'$d(xfid(ino,i,ii)) s cname=xfid(ino,i,ii) i cname?1a.e d getold1 110 | ;f i=1:1 q:'$d(xfid(ino,"a",i)) s cname=$p(xfid(ino,"a",i),"~",2) i cname?1a.e d getold1 111 | q 112 | ; 113 | getold1 ; get all old attribute values 114 | n i,ii,inop 115 | i $d(xfidx(cname))!$d(^mgtmp($j,"got",cname)) q 116 | s ^mgtmp($j,"got",cname)="" 117 | i '$d(dtyp(cname)) d dtyp^%mgsqlct 118 | s pvar="%d("_dtyp(cname)_")" 119 | i '$d(dtyp(cname,"e")) q 120 | s r=dtyp(cname,"e"),smeth=$p(r,"\",3),pce=$p(r,"\",1) 121 | s out(pce,pvar)="" 122 | s inop=$$pkey^%mgsqld(dbid,tname) 123 | i smeth="d" s line=" "_"s"_" "_pvar_"="_"$p"_"(%d,"_dlm_","_pce_")" 124 | i smeth="s" s line=" "_"s"_" "_pvar_"="_"$g"_"("_xfid(inop)_"("_pkey("o",inop)_","_$$seps^%mgsqld(dbid,tname,cname)_"))" 125 | d addline^%mgsqlc(grp,.line) 126 | q 127 | ; 128 | getold2 ; get old data record 129 | s ino=$$pkey^%mgsqld(dbid,tname) 130 | i get="n" s line=" "_"s"_" %def="_"$d"_"("_xfid(ino)_"("_pkey("o",ino)_"))" d addline^%mgsqlc(grp,.line) s line=" "_"s"_" %d="""" "_"i"_" %def#10 "_"s"_" %d="_xfid(ino)_"("_pkey("o",ino)_")" d addline^%mgsqlc(grp,.line) 131 | i get="y" s line=" "_"s"_" %d="_"$g"_"("_xfid(ino)_"("_pkey("o",ino)_"))" d addline^%mgsqlc(grp,.line) 132 | q 133 | ; 134 | killold ; kill old data record for index 135 | i '$d(pkey("o",ino)) q 136 | s subt="" i $l(subt("o",ino)) s subt=subt("o",ino) 137 | s glo=xfid(ino),key=pkey("o",ino) 138 | d k(grp,subt,glo,key) 139 | i '%set q 140 | i '%upd!(ino=$$pkey^%mgsqld(dbid,tname)) q 141 | s subt="" i $l(subt("x",ino)) s subt=subt("x",ino) 142 | s glo=xfid(ino),key=pkey("x",ino) 143 | d k(grp,subt,glo,key) 144 | q 145 | ; 146 | getnew ; get indexed data associated with new keys 147 | n inop 148 | k ^mgtmp($j,"got") 149 | s inop=$$pkey^%mgsqld(dbid,tname) 150 | s subt="",dat="%dx",glo=xfid(inop),key=pkey("n",inop),zgloz="",fail="" d g(grp,subt,dat,glo,key,zgloz) 151 | f s ino=$o(pkey("o",ino)) q:ino="" i ino'=inop f i=1:1 q:'$d(xfid(ino,i)) f ii=1:1 q:'$d(xfid(ino,i,ii)) s cname=xfid(ino,i,ii) i cname?1a.e d getnew1 152 | q 153 | ; 154 | getnew1 ; get individual data item 155 | n i,ii,inop 156 | s inop=$$pkey^%mgsqld(dbid,tname) 157 | i $d(xfidx(cname))!$d(^mgtmp($j,"got",cname)) q 158 | s ^mgtmp($j,"got",cname)="" 159 | i '$d(dtyp(cname)) d dtyp^%mgsqlct 160 | s pvar="%dx("_dtyp(cname)_")" 161 | i '$d(dtyp(cname,"e")) q 162 | s r=dtyp(cname,"e"),smeth=$p(r,"\",3),pce=$p(r,"\",1) 163 | i smeth="d" s line=" "_"s"_" "_pvar_"="_"$p"_"(%dx,"_dlm_","_pce_")" 164 | i smeth="s" s line=" "_"s"_" "_pvar_"="_"$g"_"("_xfid(inop)_"("_pkey("n",inop)_","_$$seps^%mgsqld(dbid,tname,cname)_"))" 165 | d addline^%mgsqlc(grp,.line) 166 | q 167 | ; 168 | setnew ; set new record for data/index 169 | n setdstr 170 | s setdstr=1 171 | i '$d(pkey("n",ino)) q 172 | i inop=$$pkey^%mgsqld(dbid,tname) 173 | i ino=inop s setdstr=0,cname="" f s cname=$o(dat("n",cname)) q:cname="" d setnew1 174 | i ino=inop,%upd k out d setnew2 175 | s subt="" i $l(subt("o",ino)) s subt=subt("n",ino) 176 | s glo=xfid(ino),key=pkey("n",ino),dat=$s(ino=$$pkey^%mgsqld(dbid,tname):"%d",1:"""""") 177 | i setdstr d s(grp,subt,dat,glo,key) 178 | q 179 | ; 180 | setnew1 ; set all new attribute values 181 | i '$d(dtyp(cname)) d dtyp^%mgsqlct 182 | s var=dat("n",cname) 183 | i '$d(dtyp(cname,"e")) q 184 | s r=dtyp(cname,"e"),smeth=$p(r,"\",3),pce=$p(r,"\",1) 185 | i $l(var)<250,$d(out(pce,var)) q 186 | i smeth="d" s line=" "_"s"_" $p(%d,"_dlm_","_pce_")="_var,setdstr=1 187 | i smeth="s" s line=" "_"s"_" "_xfid(ino)_"("_pkey("n",ino)_","_$$seps^%mgsqld(dbid,tname,cname)_")="_var 188 | d addline^%mgsqlc(grp,.line) 189 | q 190 | ; 191 | setnew2 ; for cases where primary key has potentially changed 192 | s cname="",com="" f s cname=$o(key("o",cname)) q:cname="" s line=line_com_key("n",cname)_"="_key("o",cname),com="," 193 | i $l(line) s line=" "_"i"_" "_line_" "_"g"_" "_%tagz d addline^%mgsqlc(grp,.line) 194 | s line=" k %xx" d addline^%mgsqlc(grp,.line) 195 | s subt="",glo=xfid(inop),key=pkey("o",inop),dvar="%xx" d gm(grp,subt,dvar,glo,key) 196 | s subt="",glo=xfid(inop),key=pkey("n",inop),dat="%xx" d m(grp,subt,dat,glo,key) 197 | s line=" k %xx" d addline^%mgsqlc(grp,.line) 198 | s subt="",glo=xfid(inop),key=pkey("o",inop) d k(grp,subt,glo,key) 199 | q 200 | ; 201 | set ; set a file reference 202 | s %set=1,^mgtmp($j,"sqlupd",tname)="~1" 203 | d index 204 | s ino=$$pkey^%mgsqld(dbid,tname) 205 | s %upd=($g(pkey("o",ino))'=$g(pkey("n",ino))) 206 | i '%upd,'%refile d elim 207 | sete ; set new 208 | d getold 209 | i %upd d getnew 210 | s inop=$$pkey^%mgsqld(dbid,tname) 211 | s ino=inop d setnew 212 | s ino="" f s ino=$o(pkey("n",ino)) q:ino="" i ino'=inop d killold,setnew 213 | k %data,data,pkey,subt,zn,zo,tn,to,andn,ando,com,com1,out,ltst 214 | q 215 | ; 216 | kill ; kill an entity reference 217 | s %set=0,^mgtmp($j,"sqlupd",tname)="~1" 218 | d index 219 | kille ; exit 220 | d getold 221 | s ino="" f s ino=$o(pkey("o",ino)) q:ino="" d killold 222 | k %data,data,pkey,subt,zn,zo,tn,to,andn,ando,com,com1,out,ltst 223 | q 224 | ; 225 | g(grp,test,dvar,glo,key,default) ; get command 226 | n line 227 | s line=$s($l(test):" i "_test,1:"")_" "_"s"_" "_dvar_"="_"$g"_"("_glo_"("_key_")"_default_")" d addline^%mgsqlc(grp,.line) 228 | q 229 | ; 230 | gm(grp,test,dvar,glo,key) ; get via merge command 231 | n line 232 | s line=$s($l(test):" i "_test,1:"")_" "_"m"_" "_dvar_"="_glo_"("_key_")" d addline^%mgsqlc(grp,.line) 233 | q 234 | ; 235 | gd(grp,test,dvar,glo,key,default,fail) ; get command with failed definition rejection 236 | s line=" "_"s"_" "_%z("vdef")_"="_"$d"_"("_glo_"("_key_")"_default_")" s:$l(fail) line=line_" "_"i"_" '"_%z("vdef")_fail d addline^%mgsqlc(grp,.line) 237 | s line=" "_"s"_" "_dvar_"="""" "_"i"_" "_%z("vdef")_"#10 "_"s"_" "_dvar_"="_glo_"("_key_")"_default d addline^%mgsqlc(grp,.line) 238 | q 239 | ; 240 | s(grp,test,dvar,glo,key) ; set command 241 | s line=$s($l(test):" "_"i"_" "_test,1:"")_" "_"s"_" "_glo_"("_key_")="_dvar d addline^%mgsqlc(grp,.line) 242 | q 243 | ; 244 | m(grp,test,dvar,glo,key) ; merge command 245 | s line=$s($l(test):" "_"i"_" "_test,1:"")_" "_"m"_" "_glo_"("_key_")="_dvar d addline^%mgsqlc(grp,.line) 246 | q 247 | ; 248 | k(grp,test,glo,key) ; kill command 249 | s line=$s($l(test):" "_"i"_" "_test,1:"")_" "_"k"_" "_glo_"("_key_")" d addline^%mgsqlc(grp,.line) 250 | q 251 | ; 252 | dbg ; set up referential actions audit trail 253 | n arg,args,i 254 | s line="" 255 | i '$d(^mgtmp($j,"ra-audit")) q 256 | s line=^("ra-audit") 257 | s line=line_",%k(0)="""_glo_"""" 258 | s arg=key s args=$$arg^%mgsqle(arg,.args) 259 | f i=1:1:args s line=line_",%k("_i_")="_args(i) 260 | q 261 | ; 262 | -------------------------------------------------------------------------------- /yottadb/_mgsqlct.m: -------------------------------------------------------------------------------- 1 | %mgsqlct ;(CM) sql compiler - get table details ; 28 Jan 2022 9:59 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlct") q 26 | ; 27 | table(dbid,qnum,data,error) ; get file particulars for each alias 28 | n tnum 29 | f tnum=1:1 q:'$d(^mgtmp($j,"from",qnum,tnum)) d table1(dbid,qnum,tnum,.data,.error) i $l(error) q 30 | q 31 | ; 32 | table1(dbid,qnum,tnum,data,error) ; get file particulars for alias alias (fid) 33 | n %d,%dv,%ref,%s,i,x,y,z,tname,alias,ino,dlm,pk,glo,com 34 | s %d=^mgtmp($j,"from",qnum,tnum) 35 | s tname=$p(%d,"~",1),alias=$p(%d,"~",2) 36 | s pk=$$pkey^%mgsqld(dbid,tname) 37 | s ino=pk i $d(^mgtmp($j,"from","i",0,alias)) s ino=^mgtmp($j,"from","i",0,alias) 38 | s %d=$$tab^%mgsqld(dbid,tname),%ref=$$ref^%mgsqld(dbid,tname,.ino),glo=%ref 39 | s dlm=$p(%d,"\",1) 40 | i dlm?1n.n,dlm>31,dlm<127 s dlm=""""_$c(dlm)_"""" 41 | i dlm?1n.n,dlm<32!dlm>126 s dlm="$char("_dlm_")" 42 | s data(qnum,tnum,"dlm")=dlm 43 | s data(qnum,tnum,"glo")=glo 44 | s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) 45 | s (z,com)="" f i=1:1 q:'$d(%ind(ino,i)) s x=%ind(ino,i) k %ind(ino,i) s:x?1a.e x=%z("dsv")_alias_"."_x_%z("dsv") s z=z_com_x,com="," 46 | s data(qnum,tnum,"key")=z 47 | i ino=pk s data(qnum,tnum,"pkey")=data(qnum,tnum,"key"),data(qnum,tnum,"pglo")=glo 48 | i ino'=pk d table2 49 | f i=1:1 q:'$d(^mgtmp($j,"sel",qnum,i)) s x=$p(^mgtmp($j,"sel",qnum,i),%z("dsv"),2) d table3 50 | s y="" f s y=$o(^mgtmp($j,"from","z",qnum,"join",y)) q:y="" i $d(^mgtmp($j,"from","z",qnum,"join",y,alias)) s x=alias_"."_y d table3 51 | s cname="" f s cname=$o(^mgtmp($j,"join",qnum,alias,cname)) q:cname="" d 52 | . s %d=$$item^%mgsqld(dbid,tname,cname),%s=$$seps^%mgsqld(dbid,tname,cname),%dv=$$derv^%mgsqld(dbid,tname,cname) 53 | . s data(qnum,tnum,"col",alias_"."_at)=%d 54 | . s data(qnum,tnum,"col",alias_"."_at,"s")=%s 55 | . i %dv'="" s data(qnum,tnum,"col",alias_"."_at,"d")=%dv 56 | . q 57 | i $l(error) q 58 | q 59 | ; 60 | table2 ; get details for primary key (for indexed search) 61 | n ino 62 | s ino=$$pkey^%mgsqld(dbid,tname) 63 | s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) 64 | s data(qnum,tnum,"pkey")="",com="" 65 | f i=1:1 q:'$d(%ind(ino,i)) s x=%ind(ino,i) k %ind(ino,i) s:x?1a.e x=%z("dsv")_alias_"."_x_%z("dsv") s data(qnum,tnum,"pkey")=data(qnum,tnum,"pkey")_com_x,com="," 66 | s %ref=$$ref^%mgsqld(dbid,tname,ino) s data(qnum,tnum,"pglo")=%ref 67 | q 68 | ; 69 | table3 ; process data item to be retrieved/derived 70 | i x="*" q 71 | i x["(",x[")" s x=$p($p(x,"(",2),")",1) 72 | s cname=x,ext="",f="" 73 | i x["." s cname=$p(x,".",2),f=$p(x,".",1) 74 | i f'=alias,f'=alias_"g" q 75 | s %d=$$item^%mgsqld(dbid,tname,cname),%s=$$seps^%mgsqld(dbid,tname,cname),%dv=$$derv^%mgsqld(dbid,tname,cname) 76 | s %defm=$$remap^%mgsqlv2(f,cname) 77 | i (%d'="")!%defm s data(qnum,tnum,"col",$p(x,".",1,2))=%d,data(qnum,tnum,"col",$p(x,".",1,2),"s")=%s,data(qnum,tnum,"col",$p(x,".",1,2),"d")=%dv 78 | q 79 | ; 80 | xfid ; retrieve all indices for table 81 | k xfid 82 | s rc=$$ind^%mgsqld(dbid,tname,.%ind) s ino=$$pkey^%mgsqld(dbid,tname) i (ino="")!'$d(%ind(ino)) g xfidx 83 | s ino="" f s ino=$o(%ind(ino)) q:ino="" s xfid(ino)=%ind(ino) k %ind(ino) d xfid1 84 | s %d=$$tab^%mgsqld(dbid,tname) s dlm=$c(34)_$c($p(%d,"\",1)+0)_$c(34) 85 | xfidx k %ind 86 | q 87 | ; 88 | xfid1 ; retrieve data for index 89 | s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) 90 | s xfidx=0 f i=1:1 q:'$d(%ind(ino,i)) s cname=%ind(ino,i),xfid(ino,i,1)=cname s:ino=$$pkey^%mgsqld(dbid,tname)&(cname?1a.e) xfidx=xfidx+1,xfidx(cname)="" 91 | k %ind(ino) 92 | q 93 | ; 94 | dtyp ; get attribute details 95 | i cname'?1a.e q 96 | i $d(dtyp(cname)) q 97 | s %d=$$col^%mgsqld(dbid,tname,cname) s dtyp(cname)=$p(%d,"\",5) 98 | i $d(xfidx(cname)) q 99 | s %d=$$item^%mgsqld(dbid,tname,cname) i %d'="" s dtyp(cname,"e")=%d 100 | q 101 | ; 102 | -------------------------------------------------------------------------------- /yottadb/_mgsqlcu.m: -------------------------------------------------------------------------------- 1 | %mgsqlcu ;(CM) sql compiler update ; 28 Jan 2022 9:59 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlcu") q 26 | ; 27 | main ; start 28 | n inop 29 | s inop=$$pkey^%mgsqld(dbid,tname) 30 | s %tagz=%zq("tag",1) 31 | s tname=^mgtmp($j,"upd","update"),alias=$p(tname," ",2),tname=$p(tname," ",1) 32 | k dtyp d xfid^%mgsqlct 33 | s line=" "_"k"_" %do,%dn,%dx" d addline^%mgsqlc(grp,.line) 34 | s %kupd=0,cname="" f s cname=$o(xfidx(cname)) q:cname="" i $d(^mgtmp($j,"upd","set",cname)) s %kupd=1 35 | f i=1:1 q:'$d(xfid(inop,i)) s cname=xfid(inop,i,1) i cname?1a.e d key 36 | s cname="" f s cname=$o(^mgtmp($j,"upd","set",cname)) q:cname="" i cname?1a.e,'$d(xfidx(cname)) d dat 37 | s %refile=0 d set^%mgsqlci 38 | s line=" "_"g"_" "_%tagz d addline^%mgsqlc(grp,.line) 39 | exit ; exit 40 | k upd,key,nkey,nkeyt,okey,okeyt,pkey,pref,idx,apc,cde,z 41 | q 42 | ; 43 | key ; determine values for keys in update 44 | d dtyp^%mgsqlct 45 | s key("o",cname)="%do("_dtyp(cname)_")" 46 | s line=" "_"s"_" "_key("o",cname)_"="_%z("dsv")_alias_"."_cname_%z("dsv") d addline^%mgsqlc(grp,.line) 47 | i '$d(^mgtmp($j,"upd","set",cname)) s line=" "_"s"_" "_"%dn("_dtyp(cname)_")="_key("o",cname) d addline^%mgsqlc(grp,.line) 48 | i '%kupd q 49 | s key("n",cname)="%dn("_dtyp(cname)_")" 50 | s var=key("n",cname) d setto 51 | q 52 | ; 53 | dat ; determine values for update and set r.i. interface 54 | d dtyp^%mgsqlct 55 | s dat("o",cname)="%do("_dtyp(cname)_")" 56 | s line=" "_"s"_" "_dat("o",cname)_"="_%z("dsv")_alias_"."_cname_%z("dsv") d addline^%mgsqlc(grp,.line) 57 | s dat("n",cname)="%dn("_dtyp(cname)_")" 58 | s var=dat("n",cname) d setto 59 | q 60 | ; 61 | setto ; reconstruct set-to statement 62 | n i 63 | i '$d(^mgtmp($j,"upd","set",cname)) s line=" "_"s"_" "_var_"="_"%do("_dtyp(cname)_")" d addline^%mgsqlc(grp,.line) q 64 | f i=1:1 q:'$d(^mgtmp($j,"upd","set",cname,"zcode",i)) s line=^mgtmp($j,"upd","set",cname,"zcode",i) d setto1 65 | q 66 | ; 67 | setto1 ; add to line 68 | n i 69 | s pn=0 i line[%z("dsv") f s pn=pn+2,x=$p(line,%z("dsv"),pn) q:x="" i x["**set**" s line=$p(line,%z("dsv"),1,pn-1)_var_$p(line,%z("dsv"),pn+1,999) s pn=pn-2 70 | d addline^%mgsqlc(grp,.line) 71 | q 72 | ; 73 | -------------------------------------------------------------------------------- /yottadb/_mgsqld.m: -------------------------------------------------------------------------------- 1 | %mgsqld ;(CM) data model access points ; 28 Jan 2022 9:59 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqld") q 26 | ; 27 | dbid(dbid) ; schema list 28 | k dbid 29 | s dbid="" f s dbid=$$nxtdbid(dbid) q:dbid="" s dbid(dbid)="" 30 | q 1 31 | ; 32 | nxtdbid(dbid) ; next schema 33 | n dbid1 34 | s dbid1=$o(^mgsqld(0,dbid)) 35 | q dbid1 36 | ; 37 | nxttname(dbid,tname) ; next table 38 | s tname=$o(^mgsqld(0,dbid,"t",tname)) 39 | q tname 40 | ; 41 | col(dbid,tname,cname) ; column details 42 | n %d,type,mtype,ano,sm 43 | s %d=$g(^mgsqld(0,dbid,"t",tname,"tc",cname)) 44 | s type=$p(%d,"\",2) 45 | s mtype="num" i type["varchar" s mtype="str" 46 | s $p(%d,"\",11)=mtype 47 | q %d 48 | ; 49 | dtype(dbid,tname,cname) 50 | n %d,type 51 | i dbid=""!(tname="")!(cname="") q "" 52 | s %d=$g(^mgsqld(0,dbid,"t",tname,"tc",cname)) 53 | s type=$p(%d,"\",2) 54 | q type 55 | ; 56 | tab(dbid,tname) ; table details 57 | n %d 58 | s %d=$g(^mgsqld(0,dbid,"t",tname,"t")) i %d="" q %d 59 | q %d 60 | ; 61 | pkey(dbid,tname) ; primary key name 62 | n %d,%pkey 63 | s %d=$g(^mgsqld(0,dbid,"t",tname,"t")) 64 | s %pkey=$p(%d,"\",2) 65 | q %pkey 66 | ; 67 | ind(dbid,tname,%ind) ; entity indices 68 | k %ind 69 | s ino="" f s ino=$o(^mgsqld(0,dbid,"t",tname,"ti",ino)) q:ino="" s rc=$$ind1(dbid,tname,ino,.%ind) 70 | q 1 71 | ; 72 | ind1(dbid,tname,ino,%ind) ; entity index 73 | k %ind(ino) 74 | s %ind(ino)=$$ref(dbid,tname,ino) 75 | q 1 76 | ; 77 | ref(dbid,tname,ino) ; entity physical reference for index 78 | s %ref=$g(^mgsqld(0,dbid,"t",tname,"ti",ino)) 79 | q %ref 80 | ; 81 | key(dbid,tname,ino,%ind) ; entity index key 82 | n i 83 | f i=1:1 q:'$d(^mgsqld(0,dbid,"t",tname,"ti",ino,i)) s %ind(ino,i)=$p(^(i),"\",1) 84 | q 1 85 | ; 86 | data(dbid,tname,%data) ; entity data 87 | n %d,cname 88 | k %data 89 | s cname="" f s cname=$o(^mgsqld(0,dbid,"t",tname,"tc",cname)) q:cname="" s %d=$$item(dbid,tname,cname) s %data(cname)=%d 90 | q 1 91 | ; 92 | item(dbid,tname,cname) ; entity data item 93 | n %d,sm,cno,nnull 94 | s %d=$g(^mgsqld(0,dbid,"t",tname,"tc",cname)) i %d="" q %d 95 | q %d 96 | ; 97 | seps(dbid,tname,cname) ; trailing keys for separately subscripted items 98 | n pce,smeth,ssubs 99 | s %d=$$item(dbid,tname,cname),smeth=$p(%d,"\",3),pce=$p(%d,"\",1) 100 | s ssubs="" i smeth="s" s ssubs=$g(^mgsqld(0,dbid,"t",tname,"tc",cname,"s")) 101 | i ssubs="" s ssubs=pce 102 | q ssubs 103 | ; 104 | derv(dbid,tname,cname) ; derived columns 105 | n derv 106 | s derv=$g(^mgsqld(0,dbid,"t",tname,"tc",cname,"d")) 107 | q derv 108 | ; 109 | defk(dbid,tname,cname) ; item defined in entity primary key 110 | n i,ino 111 | s %defk=0 112 | s ino=$$pkey(dbid,tname) i ino="" q 113 | f i=1:1 q:'$d(^mgsqld(0,dbid,"t",tname,"ti",ino,i)) i $g(^(i))=cname s %defk=1 q 114 | q %defk 115 | ; 116 | defd(dbid,tname,cname) ; item defined in entity data 117 | n %defd 118 | s %defd=$d(^mgsqld(0,dbid,"t",tname,"tc",cname)) 119 | q %defd 120 | ; 121 | defkdi(dbid,tname,cname,ino) ; item defined in specific entity index 122 | n i 123 | s %def=0 124 | f i=1:1 q:'$d(^mgsqld(0,dbid,"t",tname,"ti",ino,i)) i $g(^(i))=cname s %def=1 q 125 | q %def 126 | ; 127 | indexr(dbid,tname,ino,xsub) ; retrieve index details 128 | k xsub 129 | s tname=id 130 | s rc=$$ind1(dbid,tname,ino,.%ind) s ino=0 f s ino=$o(%ind(ino)) q:ino="" s xsub(ino)=%ind(ino) d indexr1 131 | q 1 132 | ; 133 | indexr1 ; key + aggregates 134 | n y,z 135 | s rc=$$key(dbid,tname,ino,.%ind) 136 | s (xsub(ino,"k"),com)="" f i=1:1 q:'$d(%ind(ino,i)) s y=%ind(ino,i),xsub(ino,i)=y,xsub(ino,"k")=xsub(ino,"k")_com_y,com="," 137 | q 1 138 | 139 | indexw(dbid,tname,ino,%ind) ; write index details 140 | n i,%indo 141 | k ^mgsqld(0,dbid,"t",tname,"ti",ino) 142 | s ^mgsqld(0,dbid,"t",tname,"ti",ino)=%ind(ino) 143 | f i=1:1 q:'$d(%ind(ino,i)) s ^mgsqld(0,dbid,"t",tname,"ti",ino,i)=%ind(ino,i) 144 | q 1 145 | ; 146 | nxtpname(dbid,pname) ; next proedure 147 | s pname=$o(^mgsqld(0,dbid,"p",pname)) 148 | q pname 149 | ; 150 | prc(dbid,pname) ; process details 151 | n %d 152 | s %d=$g(^mgsqld(0,dbid,"p",pname,"p")) i %d="" q %d 153 | q %d 154 | ; 155 | pdata(dbid,pname,%data) ; process data 156 | n %d,cname 157 | k %data 158 | s cname="" f s cname=$o(^mgsqld(0,dbid,"p",pname,"pc",cname)) q:cname="" s %d=$$pitem(dbid,pname,cname) s %data(cname)=%d 159 | q 1 160 | ; 161 | pitem(dbid,pname,cname) ; process data item 162 | n %d,sm,cno,nnull 163 | s %d=$g(^mgsqld(0,dbid,"p",pname,"pc",cname)) i %d="" q %d 164 | q %d 165 | ; 166 | ctable(dbid,tname,cols) ; create table 167 | n idx,idxx,col,i,ii,in,cname,ano,ano1,atu,pk,glo,dlm,olddata,cno,sm,type,typeu,nnull,cons,consu,subs 168 | s glo=$g(tname("global")) i $e(glo,1)'="^" s glo="^"_glo 169 | s dlm=$g(tname("delimiter")) s dlm=$a(dlm) 170 | i glo="" s glo="^"_tname 171 | i dlm="" s dlm=35 172 | s rc=$$data(0,tname,.olddata) 173 | s rc=$$dtable(dbid,tname) 174 | f i=1:1 q:'$d(cols(i)) d 175 | . s cname=$p(cols(i)," ",1),atu=$$lcase^%mgsqls(cname) i atu="constraint" d q 176 | . . s pk=$p(cols(i)," ",2),idx=$p($p(cols(i),"(",2),")",1) 177 | . . s idx(pk)=glo 178 | . . f ii=1:1:$l(idx,",") s cname=$p(idx,",",ii),idx(pk,ii)=cname,idxx(pk,cname)=ii 179 | . . q 180 | . q 181 | s ano=0 182 | f i=1:1 q:'$d(cols(i)) d 183 | . s nnull=0 184 | . s cname=$p(cols(i)," ",1),atu=$$lcase^%mgsqls(cname) i atu="constraint" q 185 | . s type=$p(cols(i)," ",2),typeu=$$lcase^%mgsqls(type) 186 | . f ii=3:1:$l(cols(i)," ") s name=$p(cols(i)," ",ii) d 187 | . . i name="" q 188 | . . s name=$$lcase^%mgsqls(name) 189 | . . i name="not",$$lcase^%mgsqls($p(cols(i)," ",ii+1))="null" s nnull=1 190 | . . i name="separate" s cols(i,name)="" d i ($l(subs,"""")#2) s cols(i,name)=$$rstring^%mgsqlp(subs) 191 | . . . n n,x 192 | . . . s subs="" 193 | . . . s x=$p(cols(i)," ",ii+1,999) 194 | . . . i $e(x)="(" s x=$e(x,2,999) f n=1:1 s subs=$p(x,")",1,n) q:($l(subs,"""")#2) 195 | . . . i subs'="" q 196 | . . . f n=1:1 s subs=$p(x," ",1,n) q:($l(subs,"""")#2) 197 | . . . q 198 | . . i name="derived" s cols(i,name)=$p(cols(i)," ",ii+1) 199 | . . q 200 | . s cons=$p(cols(i)," ",3,999),consu=$$lcase^%mgsqls(cons) 201 | . s nnull=0 i consu["not null" s nnull=1 202 | . s ano1=0 i '$d(idxx(pk,cname)) s ano=ano+1,ano1=ano 203 | . s cno=$p($g(olddata(cname)),"\",5)+0 i 'cno s cno=$$cno() 204 | . s sm="d" i $d(cols(i,"separate")) s sm="s" 205 | . s col(cname)=ano1_"\"_typeu_"\"_sm_"\"_nnull_"\"_cno 206 | . s name="" f s name=$o(cols(i,name)) q:name="" s col(cname,name)=cols(i,name) 207 | . q 208 | ;b 209 | s ^mgsqld(0,dbid,"t",tname,"t")=dlm_"\"_pk 210 | s cname="" f s cname=$o(col(cname)) q:cname="" d 211 | . s ^mgsqld(0,dbid,"t",tname,"tc",cname)=col(cname) 212 | . s name="" f s name=$o(col(cname,name)) q:name="" s ^mgsqld(0,dbid,"t",tname,"tc",cname,$e(name,1))=$$rstring^%mgsqlp(col(cname,name)) 213 | . q 214 | s in="" f i=1:1 s in=$o(idx(in)) q:in="" d 215 | . s ^mgsqld(0,dbid,"t",tname,"ti",in)=idx(in) 216 | . f i=1:1 q:'$d(idx(in,i)) s ^mgsqld(0,dbid,"t",tname,"ti",in,i)=$$rstring^%mgsqlp(idx(in,i)) 217 | q 1 218 | ; 219 | dtable(dbid,tname) ; delete table 220 | k ^mgsqld(0,dbid,"t",tname) 221 | q 1 222 | ; 223 | cindex(dbid,tname,ino,cols) ; create index 224 | n %ind 225 | s glo=$g(tname("global")) i $e(glo,1)'="^" s glo="^"_glo 226 | i glo="" s glo="^"_tname_ino 227 | s %ind(ino)=glo 228 | f i=1:1 q:'$d(cols(i)) s %ind(ino,i)=$$rstring^%mgsqlp(cols(i)) 229 | s rc=$$indexw^%mgsqld(dbid,tname,ino,.%ind) 230 | q 1 231 | ; 232 | cproc(dbid,pname,cols) ; create procedure 233 | n idx,idxx,col,i,ii,in,cname,ano,ano1,atu,pk,rou,dlm,olddata,cno,sm,type,typeu,nnull,cons,consu 234 | s rou=$p(pname,"_",2)_"^"_$p(pname,"_",1),dlm=35 235 | s rc=$$dproc(dbid,pname) 236 | s ano=0 237 | f i=1:1 q:'$d(cols(i)) d 238 | . s cname=$p(cols(i)," ",1),atu=$$lcase^%mgsqls(cname) i atu="constraint" q 239 | . s type=$p(cols(i)," ",2),typeu=$$lcase^%mgsqls(type) 240 | . s cons=$p(cols(i)," ",3,999),consu=$$lcase^%mgsqls(cons) 241 | . s nnull=0 i consu["not null" s nnull=1 242 | . s ano=ano+1 243 | . s cno=0 244 | . s sm="d" 245 | . s col(cname)=ano_"\"_typeu_"\"_sm_"\"_nnull_"\"_cno 246 | . q 247 | s ^mgsqld(0,dbid,"p",pname,"p")=dlm_"\"_rou 248 | s cname="" f s cname=$o(col(cname)) q:cname="" s ^mgsqld(0,dbid,"p",pname,"pc",cname)=col(cname) 249 | q 1 250 | ; 251 | dproc(dbid,tname) ; delete table 252 | k ^mgsqld(0,dbid,"p",pname) 253 | q 1 254 | ; 255 | cno() ; next column name number 256 | l +^mgsqld(0) 257 | s x=$g(^mgsqld(0))+1,^mgsqld(0)=x 258 | l -^mgsqld(0) 259 | q x 260 | ; 261 | -------------------------------------------------------------------------------- /yottadb/_mgsqle.m: -------------------------------------------------------------------------------- 1 | %mgsqle ;(CM) SQL : Embedded expressions ; 28 Jan 2022 10:00 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqle") q 26 | ; 27 | ex(outv,ex,word,code,sqlfn,error) ; 'ex' expression 28 | n i,en,fn,fun,ops 29 | i $g(ex)'="",'$d(ex(1)) s ex(1)=ex 30 | s en=0,fn=0,error="" 31 | s ops=$$ops(.ops) 32 | d word^%mgsqle1(en,.ex,.word,.ops,.error) i $l(error) g exe 33 | d vrfy^%mgsqle1(en,.word,.ops,.error) i $l(error) g exe 34 | d brac^%mgsqle1(en,.word,.ops,.error) i $l(error) g exe 35 | f i=1:1 q:'$d(word(en,i)) s fun=word(en,i) i fun[%z("df") s fun=$p(fun,%z("df"),2),fn=$$fun(fun,.sqlfn,.ops,.error) s word(en,i)=%z("df")_fn_%z("df") i $l(error) q 36 | i $l(error) g exe 37 | d comp^%mgsqle2(en,outv,.word,.sqlfn,.code,.error) 38 | exe ; exit 39 | q 40 | ; 41 | where(ex,word,error) ; validate sql 'where' predicate 42 | n en,ops 43 | i $g(ex)'="",'$d(ex(1)) s ex(1)=ex 44 | s en=0,error="" 45 | s ops=$$ops(.ops) 46 | d word^%mgsqle1(en,.ex,.word,.ops,.error) i $l(error) g wheree 47 | d vrfy^%mgsqle1(en,.word,.ops,.error) i $l(error) g wheree 48 | d brac^%mgsqle1(en,.word,.ops,.error) i $l(error) g wheree 49 | wheree ; exit 50 | q 51 | ; 52 | arg(arg,args) ; produce argument list from arguments string 53 | n pn,an,i,str,obr,cbr,chr,arg1 54 | k args s pn=0,an=0 55 | arg1 s pn=pn+1 i pn>$l(arg,",") g argx 56 | s arg1=$p(arg,",",pn) 57 | f i=pn+1:1 q:i>$l(arg,",")!($l(arg1,"""")#2) s arg1=arg1_","_$p(arg,",",i),pn=pn+1 58 | i arg1["(" s str=arg1_","_$p(arg,",",pn+1,999),(obr,cbr)=0 f i=1:1 s chr=$e(str,i) q:chr="" i $l($e(str,1,i),"""")#2 s:chr="(" obr=obr+1 s:chr=")" cbr=cbr+1 i chr=",",obr=cbr q 59 | i arg1["(" s arg1=$e(str,1,i-1),pn=pn+$l(arg1,",")-1 60 | s an=an+1,args(an)=arg1 61 | g arg1 62 | argx s args=an 63 | q args 64 | ; 65 | ops(ops) ; operator list 66 | n i,op 67 | s ops=":*:/:\:#:-:+:=:i=:<>:!=:'=:?:>:<:>=:'<:<=:'>:[:[:]:]:in:not in:like:not like:exists:not exists:between:not between:and:&:or:!:" 68 | f i=2:1:$l(ops,":") s op=$p(ops,":",i) i op'="" s ops(op)=i 69 | q ops 70 | ; 71 | oper(ops,props,neops) ; get list of valid operators 72 | n x 73 | s ops=$$ops(.x) 74 | ; list of operators which may be translated into physical restrictions 75 | s props=":=:>:<:'>:'<:>=:<=:'>=:'<=:]:']:" 76 | ; list of operators which may be used to exclude null only 77 | s neops=":'=:[:" 78 | s ops("=")="=",ops("'=")="'=" 79 | s ops(">")="<",ops("<")=">" 80 | s ops("'>")="'<",ops("'<")="'>" 81 | s ops(">=")="<=",ops("<=")=">=" 82 | s ops("]")="<",ops("']")="'<" 83 | s ops("+")="-",ops("-")="+" 84 | s ops("*")="/",ops("/")="*" 85 | q ops 86 | ; 87 | fun(fun,sqlfn,ops,error) ; decompose function fun (number fn) 88 | n funlin,pars,fn 89 | s fn=0 90 | s fun=$$fun1(fun) 91 | i fun'?1"{a}".e s error="invalid function "_fun,error(5)="HY000" q fn 92 | fun2 i fun'["{a}" g funx 93 | s funlin=$p(fun,"{a}",$l(fun,"{a}")),fn=$i(sqlfn) 94 | s wrd=$$funlin(funlin,.error) i $l(error) g funx 95 | s fun=$p(fun,"{a}",1,$l(fun,"{a}")-1)_%z("df")_fn_%z("df")_$e(funlin,$l(wrd)+1,999),sqlfn(fn)=wrd 96 | s pars=$p(wrd,"(",2,999),pars=$e(pars,1,$l(pars)-1) 97 | d pars(funlin,pars,.sqlfn,fn,.ops,.error) i $l(error) g funx 98 | g fun2 99 | funx ; exit 100 | q fn 101 | ; 102 | fun1(fun) ; insert leading delimiter '{a}' for each nested function 103 | n i,pn,pre,post 104 | s pn=0 105 | fun11 s pn=pn+1 i pn>$l(fun,"(") q fun 106 | s pre=$p(fun,"(",1,pn),post=$p(fun,"(",pn+1,999) 107 | i pre=""!(post="")!(pre=fun)!'($l(pre,"""")#2) g fun11 108 | f i=$l(pre):-1:0 i " ,("[$e(pre,i) q 109 | s fun=$e(pre,1,i)_"{a}"_$e(pre,i+1,999)_"("_post 110 | g fun11 111 | ; 112 | pars(funlin,pars,sqlfn,fn,ops,error) ; get parameter list for function 113 | n select,pn,parn,par,i 114 | s select=0 i funlin?1"$s(".e s select=1 115 | s pn=0,parn=0 116 | pars1 s pn=pn+1 i pn>$l(pars,",") g parsx 117 | s par=$p(pars,",",pn) 118 | f i=pn+1:1 q:i>$l(pars,",")!($l(par,"""")#2) s par=par_","_$p(pars,",",i),pn=pn+1 119 | i select s select("a",2)=$p(par," : ",2,999),par=$p(par," : ",1) 120 | pars11 s parn=parn+1 121 | d pars2(par,parn,.sqlfn,fn,.ops,.error) i $l(error) g parsx 122 | i select,$d(select("a",2)) s par=select("a",2) k select("a") g pars11 123 | g pars1 124 | parsx ; exit 125 | q 126 | ; 127 | pars2(par,parn,sqlfn,fn,ops,error) ; validate/bracket expression for parameter 128 | n en,ex,pn,word 129 | i par="" q ; niladic 130 | s en="f" 131 | i par?1u1":"1a.e s word(en,1)=par,entpar(par)="" g pars3 132 | s ex(1)=par d word^%mgsqle1(en,.ex,.word,.ops,.error) i $l(error) q 133 | d vrfy^%mgsqle1(en,.word,.ops,.error) i $l(error) q 134 | d brac^%mgsqle1(en,.word,.ops,.error) i $l(error) q 135 | pars3 f i=1:1 q:'$d(word(en,i)) s sqlfn(fn,"p",parn,i)=word(en,i) 136 | k word(en) 137 | q 138 | ; 139 | funlin(funlin,error) ; extract function & parameters wrd from funlin 140 | n obr,cbr,chr,i,wrd 141 | s (obr,cbr)=0 f i=1:1:$l(funlin) s chr=$e(funlin,i) i "()"[chr,$l($e(funlin,1,i),"""")#2 s:chr="(" obr=obr+1 s:chr=")" cbr=cbr+1 i obr=cbr q 142 | s wrd=$e(funlin,1,i) 143 | i 'obr!(obr'=cbr) s error="error in function "_wrd,error(5)="HY000" q wrd 144 | q wrd 145 | ; 146 | -------------------------------------------------------------------------------- /yottadb/_mgsqle2.m: -------------------------------------------------------------------------------- 1 | %mgsqle2 ;(CM) SQL : Compile code for an expression ; 28 Jan 2022 10:00 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqle2") q 26 | ; 27 | comp(en,outv,word,sqlfn,code,error) ; compile expression 28 | n wrdl 29 | d lines(en,.word,.wrdl) 30 | d code(en,.wrdl,.sqlfn,.word,outv,.code) 31 | compe ; exit 32 | q 33 | ; 34 | addline(code,line) ; add line of code 35 | s code($i(code))=line 36 | q 37 | ; 38 | lines(en,word,wrdl) ; translate word array into line arrays for coding 39 | n wrd,lno,wno,wno1,obr,cbr 40 | s lno=0 41 | lines1 s (wno,obr)=0,cbr="" 42 | f s wno=$o(word(en,wno)) q:wno="" s wrd=word(en,wno) q:wrd=")" i wrd="(" s obr=wno 43 | k word(en,obr) 44 | s lno=lno+1 45 | s cbr=wno i $l(cbr) s word(en,cbr)=%z("de")_lno_%z("de") 46 | s wno1=0,wno=obr 47 | f s wno=$o(word(en,wno)) q:wno=""!(wno=cbr) s wno1=wno1+1,wrdl(lno,wno1)=word(en,wno) k word(en,wno) 48 | i obr=0 q 49 | g lines1 50 | ; 51 | code(en,wrdl,sqlfn,word,outv,code) ; generatate code for each line 52 | n ln,exp,expx,offs,tmp,line 53 | s ln=0,expx="",offs=$l(outv)+9 54 | code1 s ln=ln+1 i '$d(wrdl(ln)) g code3 55 | s exp=$$line(ln,.wrdl,.sqlfn,.word,.code,.error) i $l(error) q 56 | f q:exp'[%z("de") d code2(en,.exp,.tmp,offs) 57 | s tmp(ln)=exp 58 | g code1 59 | code3 ; insert line(s) into routine 60 | s ln=ln-1 61 | s tmp(ln)=" "_"s"_" "_%z("dsv")_outv_%z("dsv")_"="_tmp(ln) 62 | s ln="" f s ln=$o(tmp(ln)) q:ln="" s line=tmp(ln) d addline(.code,line) 63 | q 64 | ; 65 | code2(en,exp,tmp,offs) ; try to insert sub-lines into current line 66 | n ln 67 | s ln=$p(exp,%z("de"),2) 68 | i ($l(exp)+$l(tmp(ln))+offs)<240 s exp=$p(exp,%z("de"),1)_"("_tmp(ln)_")"_$p(exp,%z("de"),3,999) k tmp(ln) q 69 | s exp=$p(exp,%z("de"),1)_%z("pv")_"("_ln_")"_$p(exp,%z("de"),3,999) 70 | s tmp(ln)=" "_"s"_" "_%z("pv")_"("_ln_")="_tmp(ln) 71 | q 72 | ; 73 | line(ln,wrdl,sqlfn,word,code,error) ; process individual line 74 | n wno,wrd,exp 75 | s wno=0,exp="" 76 | line1 s wno=wno+1 i '$d(wrdl(ln,wno)) q exp 77 | s wrd=wrdl(ln,wno) 78 | f q:wrd'[%z("df") s wrd=$$fun(wrd,.sqlfn) q:$l(error) 79 | i error'="" q exp 80 | i wrd?1a.u1"."1a.e!(wrd?1a.u1"("1a.e1")") d sqlvar^%mgsqle1(0,.word,wrd) s wrd=%z("dsv")_wrd_%z("dsv") 81 | s exp=exp_wrd 82 | g line1 83 | ; 84 | fun(wrd,sqlfn) ; generate code for in-line functions 85 | n code,fn,pre,post 86 | s code="" 87 | s pre=$p(wrd,%z("df"),1),post=$p(wrd,%z("df"),3,999) 88 | s fn=$p(wrd,%z("df"),2) 89 | s fun=sqlfn(fn),fun=$p(fun,"(",1) 90 | i fun?1"$"1a.e s code=$$m(.sqlfn,fn,fun) 91 | i fun?1"$$"1a.e s code=$$ext(.sqlfn,fn,fun) 92 | s code=pre_code_post 93 | q code 94 | ; 95 | ext(sqlfn,fn,fun) ; generate code for m extrinsic function 96 | n line,sub,i,com 97 | i fun="$$trim^%mgsqls",'$d(sqlfn(fn,"p",2)) s sqlfn(fn,"p",2,1)=""" """ 98 | i fun="$$rtrim^%mgsqls",'$d(sqlfn(fn,"p",2)) s sqlfn(fn,"p",2,1)=""" """ 99 | i fun="$$ltrim^%mgsqls",'$d(sqlfn(fn,"p",2)) s sqlfn(fn,"p",2,1)=""" """ 100 | s line=fun_"(" 101 | s sub=fun_"(" 102 | s com="" f i=1:1 q:'$d(sqlfn(fn,"p",i)) s sub=sub_com_sqlfn(fn,"p",i,1),com="," 103 | s sub=sub_")" 104 | s line=sub 105 | ;b 106 | q line 107 | ; 108 | m(sqlfn,fn,fun) ; m function 109 | n line,sub,i,com 110 | s line=fun_"(" 111 | s sub=fun_"(" 112 | s com="" f i=1:1 q:'$d(sqlfn(fn,"p",i)) s sub=sub_com_sqlfn(fn,"p",i,1),com="," 113 | s sub=sub_")" 114 | s line=sub 115 | q line 116 | q 117 | ; 118 | in(en,wrd,word,wn,obr,cbr,error) ; form expression for sql style 'in' 119 | n arg,i,op,andor,eq,obr1,cbr1,x,dlm,pre,post,arg,args,var,spc 120 | i obr'=1,'cbr s error="incorrect bracketing around arguments of the 'in' operator",error(5)="HY000" g inx 121 | s op=word(en,wn) 122 | i op="in" s andor="or",eq="=" 123 | i op="not in" s andor="and",eq="'=" 124 | s arg=wrd s args=$$arg^%mgsqle(arg,.args) 125 | s (obr1,cbr1)=0,var="",spc="" f wn=wn-1:-1:1 s x=word(en,wn) s:x="(" obr1=obr1+1 s:x=")" cbr1=cbr1+1 s var=x_spc_var,spc=" " i obr1=cbr1 s wn=wn-1 q 126 | s x="",dlm="" f i=1:1:args s x=x_dlm_var_" "_eq_" "_args(i),dlm=" "_andor_" " 127 | s x="( "_x_" )",pre=$p(lin," ",1,pn),post=$p(lin," ",pn+1,999) 128 | s lin=pre_" "_x i $l(post) s lin=lin_" "_post 129 | inx ; exit 130 | q "" 131 | ; 132 | between(en,wrd,word,wn,obr,cbr,error) ; form expression for sql style 'between' 133 | n arg,i,op,andor,eq1,eq2,obr1,cbr1,x,dlm,pre,post,arg,args,var,spc 134 | i obr'=1,'cbr s error="incorrect bracketing around arguments of the 'between' operator",error(5)="HY000" g betweenx 135 | s op=word(en,wn) 136 | i op="between" s andor="and",eq1=">=",eq2="<=" 137 | i op="not between" s andor="or",eq1="<",eq2=">" 138 | s arg=wrd s args=$$arg^%mgsqle(arg,.args) i args<2 s error="the 'between' operator takes two arguments",error(5)="HY000" g betweenx 139 | s (obr1,cbr1)=0,var="",spc="" f wn=wn-1:-1:1 s x=word(en,wn) s:x="(" obr1=obr1+1 s:x=")" cbr1=cbr1+1 s var=x_spc_var,spc=" " i obr1=cbr1 s wn=wn-1 q 140 | s x="( "_var_" "_eq1_" "_args(1)_" "_andor_" "_var_" "_eq2_" "_args(2)_" )",pre=$p(lin," ",1,pn),post=$p(lin," ",pn+1,999) 141 | s lin=pre_" "_x i $l(post) s lin=lin_" "_post 142 | betweenx ; exit 143 | q "" 144 | ; 145 | like(wrd,error) ; form expression for sql style pattern-match 146 | n wrd1,chr,i 147 | i wrd'?1""""1e.e1"""",wrd'[%z("ds") s error="invalid 'like' argument "_wrd,error(5)="HY000" q "" 148 | i wrd[%z("ds") s wrd=$$rstring^%mgsqlp(wrd) 149 | s wrd1=wrd i wrd?1""""1e.e1"""" s wrd1=$e(wrd,2,$l(wrd)-1) 150 | s wrd="" f i=1:1:$l(wrd1) s chr=$e(wrd1,i) s wrd=wrd_$s(chr="_":"1e",chr="%":".e",1:1_$c(34)_chr_$c(34)) 151 | q "" 152 | ; 153 | mpm(wrd,error) ; form expression for m style pattern-match 154 | n cn,chr,pchr,x,i 155 | s cn=0,chr="" 156 | i wrd[%z("ds") s wrd=$$rstring^%mgsqlp(wrd) 157 | mpm1 s pchr=chr,cn=cn+1 i cn>$l(wrd) g mpmx 158 | s chr=$e(wrd,cn) 159 | i chr="."!(chr?1n) f i=cn+1:1 s x=$e(wrd,i) q:x'?1n&(x'=".") s cn=cn+1,chr=chr_x 160 | i chr?1u f i=cn+1:1 s x=$e(wrd,i) q:x'?1u s cn=cn+1,chr=chr_x 161 | i chr?1a.u f i=1:1:$l(chr) s x=$e(chr,i) i "acelnpu"'[x s error="invalid pattern "_x_" in pattern match "_wrd,error(5)="HY000" q 162 | i $e(error) g mpmx 163 | i chr="""" f i=cn+1:1:$l(wrd) s x=$e(wrd,i) q:x'=""""&($l(chr,"""")#2) s cn=cn+1,chr=chr_x 164 | i chr["""",'($l(chr,"""")#2) s error="invalid element "_chr_" in pattern match "_wrd,error(5)="HY000" g mpmx 165 | i pchr="",chr?.n.1".".n g mpm1 166 | i pchr'="",pchr?.n.1".".n,chr?1a.u!(chr["""") g mpm1 167 | i pchr'="",pchr?1a.u!(pchr[""""),chr?.n.1".".n g mpm1 168 | s error="invalid pattern match "_wrd,error(5)="HY000" 169 | mpmx i chr'?1a.u,chr'["""" s error="invalid pattern match "_wrd,error(5)="HY000" 170 | q "" 171 | ; 172 | -------------------------------------------------------------------------------- /yottadb/_mgsqlo.m: -------------------------------------------------------------------------------- 1 | %mgsqlo ;(CM) query optimisation procedure ; 28 Jan 2022 10:01 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlo") q 26 | ; 27 | main(dbid,qid,sql,error) ; optimiser 28 | n qnum,word,table,rec 29 | s qnum=0 30 | opt1 s qnum=qnum+1 i '$d(^mgtmp($j,"from",qnum)) g exit 31 | d word(dbid,qnum,.word) 32 | d table(dbid,qnum,.table) 33 | d opt^%mgsqlo1(dbid,qnum,.word,.table,.rec) 34 | k word,table 35 | g opt1 36 | exit ; exit 37 | d rec(dbid,qid,.rec) 38 | q 39 | ; 40 | word(dbid,qnum,word) ; generate word array for sub-query 41 | n i,wrd 42 | f i=1:1 q:'$d(^mgtmp($j,"where",qnum,i)) s wrd=^mgtmp($j,"where",qnum,i),word(i)=wrd 43 | q 44 | ; 45 | table(dbid,qnum,table) ; generate ent array for sub-query 46 | n i,x,alias,slot,done 47 | s slot=0 48 | f i=1:1 q:'$d(^mgtmp($j,"from",qnum,i)) s x=$p(^mgtmp($j,"from",qnum,i),"~",2) i '$d(^mgtmp($j,"from","i",0,x)) s ^mgtmp($j,"from","i",0,x)=0 49 | f i=1:1 q:'$d(^mgtmp($j,"from",qnum,i)) d 50 | . s alias=$p(^mgtmp($j,"from",qnum,i),"~",2),alias(alias)=i 51 | . s table(0,i)=^mgtmp($j,"from",qnum,i)_"~"_^mgtmp($j,"from","i",0,$p(^mgtmp($j,"from",qnum,i),"~",2)) 52 | f i=1:1 q:'$d(^mgtmp($j,"from","z",qnum,"ord",i)) d 53 | . s alias=^mgtmp($j,"from","z",qnum,"ord",i) i $d(done(alias)) q 54 | . s slot=slot+1,table("ord",slot,alias(alias))="",done(alias)="" 55 | q 56 | ; 57 | rec(dbid,qid,rec) ; record optimisation details for user 58 | n ref,qnum 59 | s ref="^mgsqlx(1,dbid,qid,""opt""" 60 | k @(ref_")") 61 | f qnum=1:1 q:'$d(^mgtmp($j,"from",qnum)) d rec1(dbid,qid,qnum,ref,.rec) 62 | q 63 | ; 64 | rec1(dbid,qid,qnum,ref,rec) ; process sub-query 65 | n cum,tnum,cum 66 | s cum=1 f tnum=1:1 q:'$d(^mgtmp($j,"from",qnum,tnum)) d rec2(dbid,qid,qnum,tnum,ref,.rec,.cum) 67 | q 68 | ; 69 | rec2(dbid,qid,qnum,tnum,ref,rec,cum) ; return full optimisation details for alias 70 | n %ind,r,tname,alias,ino,kno,key,com,sc,i,x 71 | s r=^mgtmp($j,"from",qnum,tnum) 72 | s tname=$p(r,"~",1),alias=$p(r,"~",2),ino=^mgtmp($j,"from","i",0,alias) i ino="" s ino=$$pkey^%mgsqld(dbid,tname) 73 | s kno=0,key="",com="",cum("ndst")=1,sc=$$key^%mgsqld(dbid,tname,ino,.%ind) 74 | f i=1:1 q:'$d(%ind(ino,i)) s x=%ind(ino,i) k %ind(ino,i) i x?1a.e s kno=kno+1 d rec3(dbid,tname,alias,x,ino,kno,.rec,.cum) 75 | s @(ref_",qnum,tnum)")=tname_"#"_alias_"#"_ino_"#"_key 76 | q 77 | ; 78 | rec3(dbid,tname,alias,cname,ino,kno,rec,cum) ; record work involved at each level 79 | n y,nds,nds1,nds2 80 | s y=%z("dsv")_alias_"."_cname_%z("dsv") 81 | s (nds,nds1,nds2)=$s($d(^mgsqldbs("e",dbid,tname,ino,kno)):$p(^(kno),"~",1),1:0) i kno>1 s nds1=nds,(nds,nds2)=$s(nds>0:$j(nds/cum("pnds"),0,0),1:nds) 82 | s cum("pnds")=nds1,nds="~"_nds 83 | i $d(rec(y)) s:rec(y)="=" nds="[1]",nds2=1 s:rec(y)'="=" nds="[>"_nds_"<]",nds2=nds2 84 | i $e(nds)="~" s nds="["_nds_"]" 85 | s cum("ndst")=$s(nds2=1:cum("ndst")+1,nds2>1:cum("ndst")*nds2,1:cum("ndst")),cum=$s(nds2=1:cum+1,nds2>1:cum*nds2,1:cum),key=key_com_cname_"#"_cum_"#"_cum("ndst")_"#"_nds,com="," 86 | q 87 | ; 88 | -------------------------------------------------------------------------------- /yottadb/_mgsqlo1.m: -------------------------------------------------------------------------------- 1 | %mgsqlo1 ;(CM) query optimisation procedure ; 28 Jan 2022 10:01 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlo1") q 26 | ; 27 | opt(dbid,qnum,word,table,rec) ; optimise sub query 28 | n ops,props,neops,whr,rstr,notnull,join,indxa 29 | s ops=$$oper^%mgsqle(.ops,.props,.neops) 30 | d blks(.word,.whr) i $l(error) q 31 | d rstr(.whr,.ops,neops,props,.rstr,.notnull) 32 | d join(qnum,.join) 33 | d indx(dbid,.table,.indxa) 34 | d vrfy(.join,.indxa,.notnull) 35 | d optimise^%mgsqlo2(dbid,qnum,.table,.rstr,.join,.indxa,.rec) 36 | q 37 | ; 38 | blks(word,whr) ; break where statement into blocks by combinational operators 39 | n i,no,no1,ln,ln1,wrd,wrd1,op,obr,cbr,ok 40 | k whr 41 | s no1=0 f i=1:1 q:'$d(word(i)) s whr(no1,i)=word(i) 42 | s no="" 43 | blks1 s no=$o(whr(no)) i no="" g blks3 44 | s ln="" 45 | blks2 s ln=$o(whr(no,ln)) i ln="" g blks1 46 | s wrd=whr(no,ln) i wrd'="&",wrd'="!" g blks2 47 | s ln1=$o(whr(no,ln),-1) i '$l(ln1) s error="error in structure of the 'where' statement",error(5)="HY000" q 48 | s wrd1=whr(no,ln1) i wrd1[%z("db") g blks21 49 | s no1=no1+1,whr(no,ln1)=%z("db")_no1_%z("db") 50 | i wrd1'=")" s whr(no1,ln1)=wrd1 g blks21 51 | s obr=0,cbr=1 f s ln1=$o(whr(no,ln1),-1) q:ln1="" s wrd1=whr(no,ln1) s:wrd1="(" obr=obr+1 s:wrd1=")" cbr=cbr+1 k whr(no,ln1) q:obr=cbr s whr(no1,ln1)=wrd1 52 | blks21 s ln1=$o(whr(no,ln)) i '$l(ln1) s error="error in structure of the 'where' statement",error(5)="HY000" q 53 | s wrd1=whr(no,ln1) i wrd1[%z("db") g blks2 54 | s no1=no1+1,whr(no,ln1)=%z("db")_no1_%z("db") 55 | i wrd1'="(" s whr(no1,ln1)=wrd1 g blks2 56 | s obr=1,cbr=0 f s ln1=$o(whr(no,ln1)) q:ln1="" s wrd1=whr(no,ln1) s:wrd1="(" obr=obr+1 s:wrd1=")" cbr=cbr+1 k whr(no,ln1) q:obr=cbr s whr(no1,ln1)=wrd1 57 | g blks2 58 | blks3 ; recombine parts to eliminate branches caused by useless brackets 59 | s no="" 60 | blks4 s no=$o(whr(no)) i no="" g blksx 61 | s ln="" 62 | blks5 s ln=$o(whr(no,ln)) i ln="" g blks4 63 | s wrd=whr(no,ln) i wrd'[%z("db") g blks5 64 | s no1=$p(wrd,%z("db"),2) 65 | s op="",ln1=$o(whr(no,ln),-1) i $l(ln1) s op=whr(no,ln1) 66 | i op'="&",op'="!" s ln1=$o(whr(no,ln)) i $l(ln1) s op=whr(no,ln1) 67 | i op'="&",op'="!" g blks5 68 | s ok=1,ln1="" f s ln1=$o(whr(no1,ln1)) q:ln1="" s wrd1=whr(no1,ln1) i wrd1'[%z("db"),wrd1'=op s ok=0 q 69 | i 'ok g blks5 70 | k whr(no,ln) 71 | s ln1="" f s ln1=$o(whr(no1,ln1)) q:ln1="" s whr(no,ln1)=whr(no1,ln1) 72 | k whr(no1) 73 | s ln="" 74 | g blks5 75 | blksx ; exit 76 | q 77 | ; 78 | recomb(whr,stat) 79 | n n,bn,pre,pst 80 | f q:stat'[%z("db") d 81 | . s bn=$p(stat,%z("db"),2) 82 | . s pre=$p(stat,%z("db"),1) 83 | . s pst=$p(stat,%z("db"),3,999) 84 | . s n="" f s n=$o(whr(bn,n)) q:n="" s pre=pre_whr(bn,n) 85 | . s stat=pre_pst 86 | . q 87 | q stat 88 | ; 89 | rstr(whr,ops,neops,props,rstr,notnull) ; find useful restrictions 90 | n orbrn,orn,root,no,op,opn 91 | s orbrn=0,orn=0 92 | s root=$o(whr("")) i '$l(root) q 93 | s no=root,op=$$op(.whr,no,neops,props,.opn) i '$l(op) q 94 | i op="&" s orn=1 d and(.whr,no,.ops,neops,props,.opn) q 95 | i op="!" d or(.whr,no,.orbrn,.orn,.rstr,.notnull,.ops,neops,props,.opn) q 96 | s orn=1 d rstr1(.whr,no,.orbrn,.orn,.rstr,.notnull,.ops,neops,props) q 97 | q 98 | ; 99 | rstr1(whr,no,orbrn,orn,rstr,notnull,ops,neops,props) ; process individual restriction 100 | n tmp,op,obr,cbr,x,wrd,n,vn,cn,opc,opn 101 | s op=$$op(.whr,no,neops,props,.opn) i '$l(op) q 102 | i op="&"!(op="!") q 103 | s (obr,cbr)=0,x=opn f s x=$o(whr(no,x),-1) q:x="" s wrd=whr(no,x) s:wrd="(" obr=obr+1 s:wrd=")" cbr=cbr+1 q:obr>cbr s tmp(0,x)=wrd i obr=cbr q 104 | s n=0,x="" f s x=$o(tmp(0,x)) q:x="" s wrd=tmp(0,x) k tmp(0,x) s n=n+1 s tmp(0,n)=wrd 105 | s (obr,cbr)=0,n=0,x=opn f s x=$o(whr(no,x)) q:x="" s wrd=whr(no,x) s:wrd="(" obr=obr+1 s:wrd=")" cbr=cbr+1 q:cbr>obr s n=n+1,tmp(1,n)=wrd i obr=cbr q 106 | s vn=0,cn=1,opc=op d rstr2(.whr,.tmp,cn,vn,opc,.orbrn,.orn,.rstr,.notnull,neops) 107 | i $d(ops(op)) s vn=1,cn=0,opc=ops(op) d rstr2(.whr,.tmp,cn,vn,opc,.orbrn,.orn,.rstr,.notnull,neops) 108 | q 109 | ; 110 | rstr2(whr,tmp,cn,vn,opc,orbrn,orn,rstr,notnull,neops) ; resolve expression into functional restriction wrt 1 variable 111 | n i 112 | k tmp(5) f i=1:1 q:'$d(tmp(cn,i)) s tmp(5,i)=tmp(cn,i) 113 | i neops[(":"_op_":") d rstr4(.tmp,vn,op,.orbrn,.notnull) q 114 | i $d(tmp(vn,1)),'$d(tmp(vn,2)) d rstr3(.whr,.tmp,vn,opc,.orbrn,.orn,.rstr) q 115 | q 116 | ; 117 | rstr3(whr,tmp,vn,opc,orbrn,orn,rstr) ; find dependancies in constant 118 | n sqvar,andn,n,cnst,wrd,wrd1,var,alias,tname,tno 119 | s sqvar=tmp(vn,1) i sqvar'[%z("dsv") q 120 | s sqvar=$p(sqvar,%z("dsv"),2) i sqvar'?1a.e1"."1a.e q 121 | f andn=1:1 q:'$d(rstr(orbrn,sqvar,orn,andn)) 122 | s n="",cnst="" 123 | rstr31 s n=$o(tmp(5,n)) i n="" g rstr32 124 | s (wrd,wrd1)=tmp(5,n) 125 | s var="" i wrd[%z("dsv") s var=$p(wrd,%z("dsv"),2) 126 | i var?1a.e1"."1a.e s rstr(orbrn,sqvar,orn,andn,"dep",var)="" 127 | s cnst=cnst_wrd 128 | g rstr31 129 | rstr32 ; file restriction 130 | s rstr(orbrn,sqvar,orn,andn,"op")=opc 131 | s rstr(orbrn,sqvar,orn,andn,"cnst")=$$recomb(.whr,cnst) 132 | i cnst'[%z("dev") q 133 | s (alias,tname)=$p(sqvar,".",1),cname=$p(sqvar,".",2) 134 | i alias'="" s tno=$g(^mgtmp($j,"from","x",qnum,alias)) i tno'="" s tname=$p($g(^mgtmp($j,"from",qnum,tno)),"~",1) 135 | s ^mgtmp($j,"in",$p(cnst,%z("dev"),2))="~"_tname_"~"_cname 136 | q 137 | ; 138 | rstr4(tmp,vn,op,orbrn,notnull) ; evaluate possible not-null restriction 139 | n sqvar,cnst 140 | i orbrn'=0 q 141 | i '$d(tmp(vn,1))!'$d(tmp(5,1)) q 142 | i $d(tmp(vn,2))!$d(tmp(5,2)) q 143 | s sqvar=tmp(vn,1) i sqvar'[%z("dsv") q 144 | s sqvar=$p(sqvar,%z("dsv"),2) i sqvar'?1a.e1"."1a.e q 145 | s cnst=tmp(5,1) 146 | i op="'=",cnst="""""" s notnull(sqvar)="" 147 | i op="[",cnst?1""""1e.e1"""" s notnull(sqvar)="" 148 | q 149 | ; 150 | and(whr,no,ops,neops,props,opn) ; process and conditions 151 | n x,wrd,no1 152 | s x="" 153 | and1 s x=$o(whr(no,x)) i x="" q 154 | s wrd=whr(no,x) i wrd'[%z("db") g and1 155 | s no1=$p(wrd,%z("db"),2) 156 | d and2(.whr,no1,.orbrn,.orn,.rstr,.notnull,.ops,neops,props,.opn) 157 | g and1 158 | ; 159 | and2(whr,no,orbrn,orn,rstr,notnull,ops,neops,props,opn) ; branch beneath and combination 160 | n op 161 | s op=$$op(.whr,no,neops,props,.opn) 162 | i op="&" q 163 | i op="!" d or(.whr,no,.orbrn,.orn,.rstr,.notnull,.ops,neops,props,.opn) 164 | d rstr1(.whr,no,.orbrn,.orn,.rstr,.notnull,.ops,neops,props) 165 | q 166 | ; 167 | or(whr,no,orbrn,orn,rstr,notnull,ops,neops,props,opn) ; process or conditions 168 | n x,wrd 169 | s orbrn=orbrn+1,orn=0,x="" 170 | or1 s x=$o(whr(no,x)) i x="" q 171 | s wrd=whr(no,x) i wrd'[%z("db") g or1 172 | s no1=$p(wrd,%z("db"),2) 173 | d or2(.whr,no1,.orbrn,.orn,.rstr,.notnull,.ops,neops,props,.opn) 174 | g or1 175 | ; 176 | or2(whr,no,orbrn,orn,rstr,notnull,ops,neops,props,opn) ; branch beneath or combination 177 | n op 178 | s orn=orn+1 179 | s op=$$op(.whr,no,neops,props,.opn) 180 | i op="&" d and(.whr,no,.ops,neops,props,.opn) 181 | i op="!" q 182 | d rstr1(.whr,no,.orbrn,.orn,.rstr,.notnull,.ops,neops,props) 183 | q 184 | ; 185 | op(whr,no,neops,props,opn) ; extract combinational or comparison operator for group 186 | n x,wrd,wrd1 187 | s (op,opn)="" 188 | s x="" f s x=$o(whr(no,x)) q:x="" s wrd=whr(no,x),wrd1=":"_wrd_":" i wrd="!"!(wrd="&")!(neops[wrd1)!(props[wrd1) s op=wrd,opn=x q 189 | q op 190 | ; 191 | join(qnum,join) ; make comprehensive join index 192 | n jn,cname,alias,sqvar 193 | s jn=0 194 | s cname="" f s cname=$o(^mgtmp($j,"from","z",qnum,"join",cname)) q:cname="" d 195 | . s jn=jn+1 196 | . s alias="" f s alias=$o(^mgtmp($j,"from","z",qnum,"join",cname,alias)) q:alias="" d 197 | . . s sqvar=alias_"."_cname 198 | . . s join(jn,sqvar)="" 199 | . . q 200 | . q 201 | q 202 | ; 203 | indx(dbid,table,indxa) ; get all index information 204 | n i 205 | f i=1:1 q:'$d(table(0,i)) d indx1(dbid,.table,i,.indxa) 206 | ;s nofid=i-1 207 | q 208 | ; 209 | indx1(dbid,table,no,indxa) ; retrieve index data for file tname 210 | n %ind,%d,tname,cname,alias,rc,ino,kno,ano,pnds,sqvar,pkey,keyat,notnl,nds,nnds 211 | s tname=table(0,no),alias=$p(tname,"~",2),tname=$p(tname,"~",1) 212 | s rc=$$ind^%mgsqld(dbid,tname,.%ind) 213 | ; get primary key 214 | s ino=$$pkey^%mgsqld(dbid,tname),rc=$$key^%mgsqld(dbid,tname,ino,.%ind) 215 | f kno=1:1 q:'$d(%ind(ino,kno)) s cname=%ind(ino,kno) i cname?1a.e s pkey(cname)="" 216 | s ino="" 217 | indx2 s ino=$o(%ind(ino)) i ino="" g indxx 218 | i $d(^mgtmp($j,"create","index")),ino=$p(^mgtmp($j,"create","index"),"~",2) g indx2 219 | s rc=$$key^%mgsqld(dbid,tname,ino,.%ind) 220 | s kno=0,ano=0,pnds=0 221 | indx3 s kno=kno+1 i '$d(%ind(ino,kno)) g indx2 222 | s cname=%ind(ino,kno) i cname'?1a.e g indx3 223 | s ano=ano+1,sqvar=alias_"."_cname 224 | s keyat=$d(pkey(cname)) 225 | s notnl=0,%d=$$item^%mgsqld(dbid,tname,cname) i %d'="",$p(%d,"\",4) s notnl=1 226 | i keyat s notnl=1 227 | i notnl s notnull(sqvar)="" 228 | s (nds,nnds)=0 i $d(^mgsqldbs("e",dbid,tname,ino,ano)) s (nds,nnds)=$p(^(ano),"~",1) s:pnds>0 nnds=$j(nds/pnds,0,0) s pnds=nds 229 | s indxa("e",alias,ino)=ano,indxa("e",alias,ino,ano)=cname_"~"_keyat_"~"_notnl_"~"_""_"~"_nds_"~"_nnds 230 | g indx3 231 | indxx ; exit 232 | q 233 | ; 234 | vrfy(join,indxa,notnull) ; verify indices for usage 235 | n alias,cname,sqvar,sqvar1,notnl,ino,kno,ano,r,jn 236 | s alias="" 237 | vrfy1 s alias=$o(indxa("e",alias)) i alias="" g vrfyx 238 | s ino="" 239 | vrfy2 s ino=$o(indxa("e",alias,ino)) i ino="" g vrfy1 240 | i $d(indxa("cuse",alias,ino)) g vrfy2 ; index disqualified already 241 | s ano=0 242 | vrfy3 s ano=ano+1 i '$d(indxa("e",alias,ino,ano)) g vrfy2 243 | s r=indxa("e",alias,ino,ano) 244 | s cname=$p(r,"~",1),notnl=$p(r,"~",3),sqvar=alias_"."_cname 245 | i notnl g vrfy4 246 | i $d(notnull(sqvar)) s notnl=1 g vrfy4 247 | s jn="" f s jn=$o(join(jn)) q:jn=""!notnl i $d(join(jn,sqvar)) s sqvar1="" f s sqvar1=$o(join(jn,sqvar1)) q:sqvar1="" i sqvar1'=sqvar,$d(notnull(sqvar1)) s notnl=1 q 248 | vrfy4 i 'notnl s indxa("duse",alias,ino)="" g vrfy2 249 | s $p(indxa("e",alias,ino,ano),"~",3)=notnl,notnull(sqvar)="" 250 | g vrfy3 251 | vrfyx ; exit 252 | q 253 | ; 254 | -------------------------------------------------------------------------------- /yottadb/_mgsqlo2.m: -------------------------------------------------------------------------------- 1 | %mgsqlo2 ;(CM) query optimisation procedure ; 28 Jan 2022 10:01 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | s ordn=0,ordm=3 f iii=1:1:20000 s ordn=$$ord(ordm,ordn,.ord) q:ord="" w !,ordn," ",ord 26 | q 27 | a d vers^%mgsql("%mgsqlo2") q 28 | ; 29 | optimise(dbid,qnum,table,rstr,join,indxa,rec) ; optimise sub query 30 | n ord 31 | s ord=$$comb(dbid,qnum,.table,.rstr,.join,.indxa) 32 | d compapi(dbid,qnum,.table,.rstr,.join,.indxa,.rec,ord) 33 | q 34 | ; 35 | comb(dbid,qnum,table,rstr,join,indxa) ; look at combinations 36 | n optim,wkfct2,nofid,ordn,ordm,ord,ok,nrun,rec,comb,r,i,wkfct,wkfct2,wkfctb,nodes,nds,ino,inos,tname 37 | s optim=1,wkfct2=0 38 | s nofid=$o(table(0,""),-1) 39 | s ordn=0,ordm=nofid 40 | comb1 s ordn=$$ord(ordm,ordn,.ord) i ord="" g combx 41 | s ok=1 f ordn=1:1:nofid i $d(table("ord",ordn)) s nrun=$p(ord,"#",ordn) i '$d(table("ord",ordn,nrun)) s ok=0 q 42 | i 'ok g comb1 43 | d comb2(dbid,qnum,ord,nofid,.table,.rstr,.join,.indxa,.comb,.rec,optim) 44 | g comb1 45 | combx ; exit 46 | s wkfct2=$g(comb("wkfct2"))+0 47 | s ord="" f s ord=$o(comb(0,ord)) q:ord="" s r=comb(0,ord),wkfct=$p(r,"~",1),wkfctb=$p(r,"~",2),nodes=$p(r,"~",3) i wkfct=wkfct2 s nds(nodes,wkfctb,ord)="" 48 | s nodes=$o(nds("")) i $l(nodes) s wkfctb=$o(nds(nodes,""),-1) i $l(wkfctb) s ord=$o(nds(nodes,wkfctb,"")) 49 | s inos="" 50 | i ord'="",$d(comb(0,ord)) s inos=$p(comb(0,ord),"~",4) 51 | i ord="" s ordn=$$ord(ordm,0,.ord) 52 | f ordn=1:1:ordm s nrun=$p(ord,"#",ordn) d 53 | . s tname=$p(table(0,nrun),"~",1) 54 | . s ino=$p(inos,"#",ordn) 55 | . i ino="" s ino=$$pkey^%mgsqld(dbid,tname) 56 | . s $p(table(0,nrun),"~",3)=ino 57 | . q 58 | q ord 59 | ; 60 | comb2(dbid,qnum,ord,nofid,table,rstr,join,indxa,comb,rec,optim) ; evaluate combination 61 | n inos,wkfcts,nodess,dlms,nord,nodes,nodes1,wkfct,wkfct1,wkfct2,wkfcts,wkfctb1,wkfctb2,wkfctbn1,nord,nrun,tname,alias,ino,inos,got 62 | s (inos,wkfcts,nodess,dlms)="" 63 | s nord=0,nodes1=0,wkfct1=0,wkfct2=0,wkfctb1=0,wkfctbn1=0 64 | comb21 s nord=nord+1,nrun=$p(ord,"#",nord) 65 | s alias=table(0,nrun),tname=$p(alias,"~",1),alias=$p(alias,"~",2) 66 | s ino=$$idx(dbid,qnum,tname,alias,.rstr,.join,.indxa,.got,.nodes,.wkfct,.rec,optim),got("f",alias)="" 67 | s nodes1=nodes1+nodes,wkfct1=wkfct1+(wkfct/nofid) 68 | s wkfctb1=wkfctb1+(wkfct/nord),wkfctbn1=wkfctbn1+(1/nord) 69 | s inos=inos_dlms_ino,wkfcts=wkfcts_dlms_wkfct,nodess=nodess_dlms_nodes,dlms="#" 70 | i nordwkfct2 s wkfct2=wkfct1 74 | s comb(0,ord)=wkfct1_"~"_wkfctb2_"~"_nodes1_"~"_inos_"~"_wkfcts_"~"_nodess 75 | s comb("wkfct2")=wkfct2 76 | q 77 | ; 78 | idx(dbid,qnum,tname,alias,rstr,join,indxa,got,nodes,wkfct,rec,optim) ; select best index (output: ino, dep, sat, nodes, wkfct) 79 | n ino,inop,maxdep,maxsat,maxscr,ano,nnodes,rstrto,rstrn,dep,sat,scr,r,cname,nnodes,sqvar,orn,andn,use,idx,nds 80 | s ino="",maxdep=0,maxsat=0,maxscr=0 81 | idx1 s ino=$o(indxa("e",alias,ino)) i ino="" g idxx 82 | i $d(indxa("cuse",alias,ino)) g idx1 83 | i optim,$d(indxa("duse",alias,ino)) g idx1 84 | k got("a",alias) 85 | s ano=0,nodes=0,rstrto=-1,rstrn=0 86 | idx2 s ano=ano+1 i '$d(indxa("e",alias,ino,ano)) g idx2x 87 | s r=indxa("e",alias,ino,ano) 88 | s cname=$p(r,"~",1),nnodes=$p(r,"~",6),sqvar=alias_"."_cname 89 | d idx3(sqvar,ino,.rstr,.join,.use,.got) 90 | s got("a",alias,cname)="" 91 | i '$d(use(ino,sqvar)) s:rstrto=-1 rstrto=ano-1 s nodes=nodes+nnodes 92 | i $d(use(ino,sqvar)) s rstrn=rstrn+1 93 | g idx2 94 | idx2x ; index processed 95 | s ano=ano-1 96 | s dep=rstrto/ano,sat=rstrn/ano 97 | i dep>maxdep s maxdep=dep 98 | i sat>maxsat s maxsat=sat 99 | s idx(ino)=dep_"~"_sat_"~"_(nodes+0)_"~"_(dep+sat) 100 | g idx1 101 | idxx ; choose best index 102 | ; eliminate useless indices 103 | s ino="" f s ino=$o(idx(ino)) q:ino="" s r=idx(ino),dep=$p(r,"~",1),sat=$p(r,"~",2) i depmaxscr s maxscr=scr 106 | s ino="" f s ino=$o(idx(ino)) q:ino="" s r=idx(ino),scr=$p(r,"~",4) i scrordm s ok=0 178 | i 'ok s x="" 179 | q x 180 | ; 181 | compapi(dbid,qnum,table,rstr,join,indxa,rec,ord) ; interface to compiler 182 | n optim,nofid,ordn,comb,nord,nino,i,tname,alias 183 | s optim=0 184 | s nofid=$o(table(0,""),-1) 185 | s table("ordx")=ord 186 | ; process opimisation hints 187 | i $d(^mgtmp($j,"from","i","f")) d 188 | . s nord="" 189 | . i '$d(table("ord")) f i=1:1:nofid s nord=nord_$s(i>1:"#",1:"")_i 190 | . f i=1:1:nofid d 191 | . . s tname=$p(table(0,i),"~",1),alias=$p(table(0,i),"~",2),nino="" 192 | . . i alias'="" s nino=$g(^mgtmp($j,"from","i","f",alias)) 193 | . . i nino="" s nino=$g(^mgtmp($j,"from","i","f",tname)) 194 | . . i nino'="" s $p(table(0,i),"~",3)=nino 195 | . . q 196 | . s ord=nord,table("ordx")=ord 197 | . q 198 | ; optimisation complete and hints acknowledged 199 | k ^mgtmp($j,"from",qnum),^mgtmp($j,"from","x",qnum) 200 | f ordn=1:1:nofid d compapi1(dbid,qnum,.table,.rstr,.join,.indxa,ord,ordn) 201 | d comb2(dbid,qnum,ord,nofid,.table,.rstr,.join,.indxa,.comb,.rec,optim) 202 | q 203 | ; 204 | compapi1(dbid,qnum,table,rstr,join,indxa,ord,ordn) ; disallow all indices except chosen one 205 | n nrun,alias,tname,ino,ino1 206 | s nrun=$p(ord,"#",ordn) 207 | s alias=table(0,nrun),tname=$p(alias,"~",1),ino=$p(alias,"~",3),alias=$p(alias,"~",2) 208 | k indxa("cuse",alias,ino) 209 | s ino1="" f s ino1=$o(indxa("e",alias,ino1)) q:ino1="" i ino1'=ino s indxa("cuse",alias,ino1)="" 210 | s ^mgtmp($j,"from",qnum,ordn)=tname_"~"_alias,(^mgtmp($j,"from","x",qnum,tname),^mgtmp($j,"from","x",qnum,alias))=ordn,^mgtmp($j,"from","i",0,alias)=ino 211 | q 212 | ; 213 | -------------------------------------------------------------------------------- /yottadb/_mgsqlp.m: -------------------------------------------------------------------------------- 1 | %mgsqlp ;(CM) sql language processor ; 28 Jan 2022 10:02 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlp") q 26 | ; 27 | main(sql,line,error) ; entry 28 | n sql2,wrk 29 | s error="" 30 | s qnummax=0 31 | k ^mgtmp($j,"translate") 32 | main1 ; re-entry 33 | k ^mgtmp($j,"cmnd") 34 | ;k wrk,blk,tmp,sql,log,declare 35 | s error="" 36 | d cmnd(.sql2) 37 | d rips(.line,.wrk,.error) i $l(error) g exit 38 | d crlf(.wrk) 39 | s qnummax=$$cdel(.sql2,.wrk,.sql,.error) i $l(error) g exit 40 | d main^%mgsqlp1(qnummax,.sql2,.wrk,.sql,.error) i $l(error) g exit 41 | i $g(sql(1,2))="from "_%z("dq")_2_%z("dq")_" t0" d cog i ok g main1 42 | exit k tmp,blk 43 | q qnummax 44 | ; 45 | cmnd(sql2) ; sql2 commands 46 | n x 47 | k sql2 48 | f x="select","from","where","group","having","order","call" s sql2(x)=0 49 | f x="join","natural","outer","left","right","full","inner","cross","outer","as","on","using" s sql2(x)=1 50 | f x="exists","not","and","or","like","in","between" s sql2(x)=2 51 | f x="update","delete","insert","attributes","into","values","set" s sql2(x)=3 52 | f x="union","intersect","except" s sql2(x)=4 53 | f x="transaction","create","drop","by","all" s sql2(x)=5 54 | f x="commit","current_date","current_time","current_timestamp","start","begin","stop" s sql2(x)=7 55 | f x="cursor","eof","last","notnull","rollback" s sql2(x)=7 56 | q 57 | ; 58 | rips(line,wrk,error) ; rip out all literals and comments 59 | n ln,ln1,ln2,cn,cn1,cn2,char,charp,charn,txt,instring,sno,qno,mrk 60 | s ln="" f s ln=$o(line(ln)) q:ln="" s wrk(ln)=line(ln) 61 | s sno=0 62 | rips0 k sno(0) 63 | s instring=0,string="" 64 | s ln="" 65 | rips1 s ln=$o(wrk(ln)) i ln="" g rips3 66 | s txt=wrk(ln),char=" ",txt=$tr(txt,"'","""") 67 | s cn=0 68 | rips2 s cn=cn+1,charp=char,char=$e(txt,cn),charn=$e(txt,cn+1) i char="" g rips1 69 | i 'instring,(charp_char)=" ;"!((charp_char_charn)=" --") s txt=$e(txt,1,cn-2) k wrk(ln) s:$l(txt) wrk(ln)=txt g rips2 ; remove comment 70 | i char=$c(34),'instring s sno=sno+1,qno=0,instring=1,sno(0,sno,0,0)=ln,sno(0,sno,0,1)=cn 71 | i char=$c(34),instring s qno=qno+1 72 | i char'=$c(34),instring,'(qno#2) s ^mgtmp($j,"string",sno)=string,instring=0,string="" g rips3 73 | i instring s string=string_char,sno(0,sno,1,0)=ln,sno(0,sno,1,1)=cn 74 | g rips2 75 | rips3 i instring,'(qno#2) s ^mgtmp($j,"string",sno)=string,instring=0,string="" 76 | i instring s error="statement contains unterminated literal",error(5)="HY000" g ripsx 77 | s sno=$o(sno(0,"")) i '$l(sno) g ripsx 78 | s mrk=%z("ds")_sno_%z("ds") 79 | s ln1=sno(0,sno,0,0),cn1=sno(0,sno,0,1) 80 | s ln2=sno(0,sno,1,0),cn2=sno(0,sno,1,1) 81 | i ln1=ln2 s wrk(ln1)=$e(wrk(ln1),1,cn1-1)_mrk_$e(wrk(ln1),cn2+1,9999) g rips0 82 | s wrk(ln1)=$e(wrk(ln1),1,cn1-1)_mrk 83 | s ln=ln1 f s ln=$o(wrk(ln)) q:ln=""!(ln'$l(txt," ") g cdel1r 107 | s wrd=$p(txt," ",pn) 108 | i '$l(wrd) g cdel2 ; this shouldn't happen 109 | s pre="" f q:"()"'[$e(wrd,1) s pre=pre_$e(wrd,1),wrd=$e(wrd,2,9999) i '$l(wrd) q 110 | s pst="" f q:"()"'[$e(wrd,$l(wrd)) s pst=$e(wrd,$l(wrd))_pst,wrd=$e(wrd,1,$l(wrd)-1) i '$l(wrd) q 111 | i wrd="" g cdel2r 112 | s wrd1=$$lcase^%mgsqls(wrd) 113 | i $l(wrd1)>128 g cdel2r 114 | i $l(wrd1)>2,$e(wrd1,$l(wrd1))=";" s wrd2=$e(wrd1,1,$l(wrd1)-1) i $d(sql2(wrd2)) s wrd1=wrd2 115 | i '$d(sql2(wrd1)) g cdel2r 116 | s (wrd0,wrd)=wrd1 117 | i wrd0="transaction"!(wrd0="start")!(wrd0="begin")!(wrd0="commit")!(wrd0="rollback") s pn=$$cdel5(.sql2,$p(wrd0,";",1),txt,pn,.sql,.error) g cdel2 118 | i wrd0="select" s qnum=qnum+1,wrd=$s(qnum=1:"(",1:"")_%z("dq")_qnum_%z("dq")_%z("dc")_wrd_%z("dc") 119 | i wrd0'="select",$d(sql2(wrd)),"034"[sql2(wrd) d cdel3(.wrd,.qnum) 120 | s ^mgtmp($j,"cmnd",qnum,wrd0)=ln 121 | cdel2r s txtn=txtn_" "_pre_wrd_pst 122 | g cdel2 123 | cdel1r s txtn=$$trim^%mgsqls(txtn," ") i '$l(txtn) k wrk(ln) g cdel1 124 | s wrk(ln)=txtn,txtn="" 125 | g cdel1 126 | cdelx ; exit 127 | s qnummax=qnum 128 | i qnummax s ln=$o(wrk(""),-1) i $l(ln) s wrk(ln)=wrk(ln)_")" 129 | q qnummax 130 | ; 131 | cdel3(wrd,qnum) ; process main-line command 132 | s wrd=%z("dc")_wrd_%z("dc") 133 | i wrd["update" s wrd=%z("dc")_"from"_%z("dc")_" "_wrd 134 | i wrd["delete"!(wrd["update") s qnum=qnum+1,wrd=$s(qnum=1:"(",1:"")_%z("dq")_qnum_%z("dq")_%z("dc")_"select"_%z("dc")_" "_wrd 135 | q 136 | ; 137 | cdel5(sql2,wrd,txt,pn,sql,error) ; transaction processing command 138 | n cmnd,name 139 | s cmnd=$p($p(txt," ",pn+1),";",1) 140 | s cmnd=$$lcase^%mgsqls(cmnd) 141 | i cmnd="transaction"!(wrd="transaction") s pn=pn+1 142 | i cmnd=""!(cmnd="transaction") s cmnd=wrd 143 | i cmnd="begin" s cmnd="start" 144 | s name="" i cmnd="start"!(cmnd="begin") s name=$p(txt," ",pn+1) 145 | i name'="",$d(sql2(name)) s name="" 146 | i $l(name)>2,$e(name,$l(name))=";",$d(sql2($e(name,1,$l(name)-1))) s name="" 147 | i name'="",$d s pn=pn+1 148 | i cmnd'="begin",cmnd'="start",cmnd'="commit",cmnd'="rollback" s error="invalid command '"_cmnd_"' for transaction processing",error(5)="HY000" q pn 149 | s sql("txp",0,cmnd)=name i name?1":"1a.e s inv($p(name,":",2,9999))="" 150 | q pn 151 | ; 152 | cdel7(line) ; remove ambiguous syntax 153 | n dlm,len,pn,pn1,pre,post,post1,obr,cbr,i,c,wrd,wrduc 154 | s dlm="substring" 155 | s len=$l(line,dlm) 156 | i len<2 q line 157 | s pn=len 158 | cdel71 s pre=$p(line,dlm,1,pn-1),post=$p(line,dlm,pn,9999) 159 | i post'?." "1"("1e.e g cdel71 160 | s (obr,cbr)=0 f i=1:1 s c=$e(post,i) s:c="(" obr=obr+1 s:c=")" cbr=cbr+1 i obr,obr=cbr q 161 | i 'obr g cdel71 162 | i obr'=cbr g cdel71 163 | s post1=$e(post,i+1,99999) 164 | s post=$e(post,1,i) 165 | f pn1=1:1:$l(post," ") s wrd=$p(post," ",pn1) d 166 | . s wrduc=$$lcase^%mgsqls(wrd) 167 | . i wrduc="from"!(wrduc="for") s $p(post," ",pn1)="," 168 | . q 169 | s line=pre_dlm_post_post1 170 | s pn=pn-1 i pn>1 g cdel71 171 | q line 172 | ; 173 | rems(txt) ; trim and remove surplus spaces from txt 174 | n pn,wrd,txt1 175 | i '$l(txt) q 176 | s txt=$$trim^%mgsqls(txt," ") i '$l(txt) q 177 | f pn=1:1:$l(txt," ") s txt1=$p(txt," ",pn+1,9999) i txt1?1" ".e s txt1=$$ltrim^%mgsqls(txt1," "),txt=$p(txt," ",1,pn)_" "_txt1 178 | q txt 179 | ; 180 | remsc(txt) ; remove spaces from comma in context of natural separator 181 | n pn,wrd,txt1 182 | f pn=1:1 q:txt'[" "!(pn=$l(txt," ")) s wrd=$p(txt," ",pn) q:wrd="" s txt1=$p(txt," ",pn+1,9999) i $e(wrd,$l(wrd))=","!($e(txt1,1)=",") s txt=$p(txt," ",1,pn)_$p(txt," ",pn+1,9999),pn=pn-1 183 | q txt 184 | ; 185 | cog ; cognos translations 186 | s ok=0 187 | i $g(sql(1,1))'?1"select ".e q 188 | i $g(sql(2,1))'?1"select min(".e q 189 | i $g(sql(2,2))'?1"from ".e q 190 | s sel=$p($g(sql(1,1)),"select ",2) 191 | s cname=$p($p($g(sql(2,1)),"select min(",2),")",1) 192 | s sel1="",com="" f i=1:1:$l(sel,",") s x=$p(sel,",",i),sel1=sel1_com_cname_" "_$p(x," ",2),com="," 193 | k line 194 | s ok=1 195 | s line(1)="select distinct "_sel1 196 | s line(2)=sql(2,2) 197 | s line(3)="where "_cname_" > -7" 198 | m ^mgtmp($j,"translate")=line 199 | ; 200 | ;s line(1)="select distinct a.lab membercaption3, a.lab usevalue, a.lab membercaption6, a.lab displayvalue" 201 | ;s line(2)="from lab-test a" 202 | ; 203 | ;sql(0,1)=%z("dq"_"1"_%z("dq") 204 | ;sql(1,1)="select t0.c0 membercaption3,t0.c1 usevalue,t0.c0 membercaption6,t0.c1 displayvalue" 205 | ;sql(1,2)="from "_%z("dq")_"2"_%z("dq") t0" 206 | ;sql(1,3)="order by 4 asc" 207 | ;sql(2,1)="select min(lab-test.lab) c0,lab-test.lab c1" 208 | ;sql(2,2)="from lab-test lab-test" 209 | ;sql(2,3)="group by lab-test.lab,lab-test.lab" 210 | q 211 | ; 212 | test ; test 213 | k 214 | d gvars^%mgsqlv("",.%z) 215 | g test2 216 | set line(1)="select t0.c0 membercaption3 , t0.c1 usevalue , t0.c0 membercaption6 , t0.c1 displayvalue" 217 | set line(2)="from (" 218 | set line(3)="select min(lab-test.lab) c0 , lab-test.lab c1" 219 | set line(4)="from lab-test lab-test" 220 | set line(5)="group by lab-test.lab , lab-test.lab) t0" 221 | set line(6)="order by 4 asc" 222 | s qnummax=$$main(.sql,.line) 223 | k %z 224 | q 225 | test1 ; 226 | set line(1)="select a.pat-num, a.pat-nam" 227 | set line(2)="into :xxx, :yyy" 228 | set line(3)="from patient a" 229 | set line(4)="where a.pat-num > :strt and a.pat-num [ ""xxx""" 230 | s qnummax=$$main(.sql,.line) 231 | k %z 232 | q 233 | test2 ; 234 | s line(1)="select distinct a.num, a.name from patient a" 235 | s qnummax=$$main(.sql,.line) 236 | k %z 237 | q 238 | ; 239 | -------------------------------------------------------------------------------- /yottadb/_mgsqlr.m: -------------------------------------------------------------------------------- 1 | %mqsqlr ;(CM) MGSQL routine management ; 28 Jan 2022 10:02 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlr") q 26 | ; 27 | zname(var) ; get routine name 28 | i $$isydb^%mgsqls() q "s "_var_"=$p($zposition,""^"",2)" 29 | q "s "_var_"=$zn" 30 | ; 31 | zd(rou) ; routine defined 32 | new $ztrap set $ztrap="zgoto "_$zlevel_":zde^%mgsqlr" 33 | i $$isydb^%mgsqls() g zdydb 34 | x "zr zl @rou" 35 | q 1 36 | zde ; error 37 | q 0 38 | zdydb ; yottadb 39 | n dev 40 | s dev=$zd_rou_".m" 41 | o dev:(readonly) s ok=$t 42 | c dev 43 | q ok 44 | ; 45 | zn(rou) ; get next routine 46 | q "" 47 | ; 48 | zr(rou) ; delete routine 49 | i $$isydb^%mgsqls() g zrydb 50 | x "zr zs @rou" 51 | q 1 52 | zrydb ; yottadb 53 | n dev 54 | s dev=$zd_rou_".m" 55 | o dev:(truncate) 56 | c dev:(delete) 57 | q 1 58 | ; 59 | zs(rou,code,mxi) ; save routine 60 | i $$isydb^%mgsqls() g zsydb 61 | x "zr f i=1:1:mxi zi @code zs:i=mxi @rou" 62 | q 1 63 | zsydb ; yottadb 64 | n i,dev 65 | s dev=$zd_rou_".m" 66 | o dev:(truncate) 67 | u dev f i=1:1:mxi w @code_$c(10) 68 | c dev 69 | zlink dev 70 | q 1 71 | ; 72 | -------------------------------------------------------------------------------- /yottadb/_mgsqls.m: -------------------------------------------------------------------------------- 1 | %mgsqls ;(CM) general utilities ; 28 Jan 2022 10:02 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqls") q 26 | ; 27 | isydb() ; see if this is YottaDB 28 | n zv 29 | s zv=$$getzv() 30 | i zv["YottaDB" q 1 31 | q 0 32 | ; 33 | isgtm() ; see if this is GT.M 34 | n zv 35 | s zv=$$getzv() 36 | i zv["GT.M" q 1 37 | q 0 38 | ; 39 | isidb() ; see if this is an InterSystems database 40 | i $zv["ISM" q 1 41 | i $zv["Cache" q 2 42 | i $zv["IRIS" q 3 43 | q 0 44 | ; 45 | ismsm() ; see if this is MSM 46 | i $zv["MSM" q 1 47 | q 0 48 | ; 49 | isdsm() ; see if this is DSM 50 | i $zv["DSM" q 1 51 | q 0 52 | ; 53 | ism21() ; see if this is M21 54 | i $zv["M21" q 1 55 | q 0 56 | ; 57 | getzv() ; Get $ZV 58 | ; ISC IRIS: IRIS for Windows (x86-64) 2019.2 (Build 107U) Wed Jun 5 2019 17:05:10 EDT 59 | ; ISC Cache: Cache for Windows (x86-64) 2019.1 (Build 192) Sun Nov 18 2018 23:37:14 EST 60 | ; GT.M: GT.M V6.3-004 Linux x86_64 61 | ; YottaDB: YottaDB r1.22 Linux x86_64 62 | new $ztrap set $ztrap="zgoto "_$zlevel_":getzve^%mgsqls" 63 | q $zyrelease 64 | getzve ; Error 65 | q $zv 66 | ; 67 | getzvv() ; Get version from $ZV 68 | n zv,i,ii,x,version 69 | s zv=$$getzv() 70 | i $$isidb() d q version 71 | . f i=1:1 s x=$p(zv," ",i) q:x="" i x["(Build" s version=$p(zv," ",i-1) q 72 | . q 73 | s x=$$isydb() 74 | i x=1 s version=$p($p(zv," V",2)," ",1) q version 75 | i x=2 s version=$p($p(zv," r",2)," ",1) q version 76 | s version="" f i=1:1 s x=$e(zv,i) q:x="" i x?1n d q 77 | . f ii=i:1 s x=$e(zv,ii) q:x=""!('((x?1n)!(x="."))) s version=version_x 78 | . q 79 | q version 80 | ; 81 | getsys() ; Get system type 82 | n systype 83 | s systype=$s($$isidb()>2:"IRIS",$$isidb()=2:"Cache",$$isidb()=1:"ISM",$$ism21():"M21",$$ismsm():"MSM",$$isdsm():"DSM",$$isydb()>1:"YottaDB",$$isgtm()=1:"GTM",1:"") 84 | q systype 85 | ; 86 | crc(str,mode) ; cyclic redundancy check 87 | n x,i 88 | s x=0 f i=1:1:$l(str) s x=x+$a(str,i) 89 | q x 90 | ; 91 | error() ; get last error 92 | i $$isydb() q $zs 93 | q $ze 94 | ; 95 | seterror(v) ; Set error 96 | q 97 | ; 98 | uci() ; get uci name 99 | i $$isydb() q $zg 100 | x "s uci=$namespace" 101 | q uci 102 | ; 103 | cuci(uci) ; change uci 104 | i $$isydb() q $zg 105 | x "zn uci" 106 | q 1 107 | ; 108 | gtmgr ; restore global 109 | s dev="/opt/gtm63/cm.go" 110 | o dev:(readonly) 111 | u dev f i=1:1 r x q:x="" s ref=$p(x,$c(1),1),data=$p(x,$c(1),2),@ref=data 112 | c dev 113 | q 114 | ; 115 | flush() ; flush output buffer 116 | i $$isydb() q 117 | w *-3 118 | q 119 | ; 120 | trim(x,chrs) ; trim leading/trailing spaces from text 121 | q $$ltrim($$rtrim(x,chrs),chrs) 122 | ; 123 | ltrim(x,chrs) ; trim leading spaces from text 124 | i chrs="" s chrs=" " 125 | f q:chrs'[$e(x,1) s x=$e(x,2,9999) i x="" q 126 | q x 127 | ; 128 | rtrim(x,chrs) ; trim trailing spaces from text 129 | n len 130 | i chrs="" s chrs=" " 131 | s len=$l(x) f q:chrs'[$e(x,len) s x=$e(x,1,len-1),len=len-1 i x="" q 132 | q x 133 | ; 134 | rreplace(x,this,with) ; recursive replace 135 | f q:$e(x,1)'[this s x=$p(x,this,1)_with_$p(x,this,2,9999) 136 | q x 137 | ; 138 | ucase(x) ; convert string to upper-case 139 | q $tr(x,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 140 | ; 141 | lcase(x) ; convert string to lower-case 142 | q $tr(x,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") 143 | ; 144 | hextodec(x) ; convert hexadecimal to decimal 145 | n len,d,n,c 146 | ;w !,">>>",x 147 | s len=$l(x),x=$$lcase(x) 148 | s d=0 149 | f n=len:-1:1 s c=$e(x,n),d=d+(($f("0123456789abcdef",c)-2)*(16**(len-n))) ;w !,c," = ",len," ",n," ",d," ### ",$f("0123456789abcdef",c)-2," ### ",16**(len-n)," === ",($f("0123456789abcdef",c)-2)*(16**(len-n)) 150 | w ! 151 | q d 152 | ; 153 | urldecode(x) ; URL decode 154 | n y,cx,xy,i 155 | s y="" 156 | f i=1:1:$l(x) s cx=$e(x,i) q:cx="" d 157 | . s cy=cx 158 | . i cx="+" s cy=" " 159 | . i cx="%" s cy=$c($$hextodec($e(x,i+1,i+2))) s i=i+2 160 | . s y=y_cy 161 | . q 162 | q y 163 | ; 164 | cdate() ; current date 165 | q $p($h,",",1) 166 | ; 167 | ctime() ; current time 168 | q $p($h,",",2) 169 | ; 170 | ts() ; time stamp 171 | q $h 172 | ; 173 | mv() ; missing value 174 | q "" 175 | ; 176 | age(mdate) ; calculate age 177 | q (+$h-mdate)\365.25 178 | ; 179 | dsep() ; get date separator 180 | n sep 181 | s sep="/" 182 | q sep 183 | ; 184 | ddate(mdate,format) ; decode M date 185 | n d,m,y,ddate,sep 186 | i mdate="" q "" 187 | s sep=$$dsep() 188 | s ddate=$zd(mdate,1) 189 | s d=$p(ddate,sep,2) 190 | s m=$p(ddate,sep,1) 191 | s y=$p(ddate,sep,3) 192 | i $$isydb(),y<100 d 193 | . i mdate<58074 s y=y+1900 194 | . i mdate'<58074 s y=y+2000 195 | . q 196 | i '$$isydb(),y<100 d 197 | . i mdate<58074 s y=y+1900 198 | . q 199 | s ddate=y_"-"_m_"-"_d 200 | q ddate 201 | ; 202 | edate(ddate,format) ; encode M date 203 | n dd,dj,djstr,dl,dlm,dm,dy,i,mdate,x,y,ok 204 | i ddate="" q "" 205 | s ddate=$$ltrim(ddate," ") 206 | i ddate?8n s dy=$e(ddate,1,4),dm=$e(ddate,5,6),dd=$e(ddate,7,8) g edate1 207 | i ddate?4n1"-"2n1"-"2n s dy=$p(ddate,"-",1),dm=$p(ddate,"-",2),dd=$p(ddate,"-",3) g edate1 208 | i ddate["." s dlm="." 209 | i ddate["," s dlm="," 210 | i ddate["/" s dlm="/" 211 | i ddate[" " s dlm=" " 212 | s dd=$p(ddate,dlm,1) 213 | s dm=$p(ddate,dlm,2) 214 | s dy=$p(ddate,dlm,3) 215 | edate1 s mdate="" 216 | i dm'?1N.N d 217 | . s dm=$$lcase(dm) 218 | . f i=1:1:12 i $p("jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec",",",i)=dm s dm=i q 219 | . i dm'?1n.n s dm=0 220 | . q 221 | i ((dd'<1)&(dd'>31)&(dm'<1)&(dm'>12)&(dy'<0)&(dy'>9999)) d 222 | . i dy<100,dy<30 s dy=dy+2000 223 | . i dy<100,dy'<30 s dy=dy+1900 224 | . s dl=0 225 | . i (((dy#4)=0)&(dy'=1900)) s dl=1 226 | . s ok=1 227 | . i ((dd>30)&((dm=4)!(dm=6)!(dm=9)!(dm=11))) s ok=0 228 | . i ((dm=2)&(((dl=0)&(dd>28))!((dl=1)&(dd>29)))) s ok=0 ; 229 | . i (ok=1) d 230 | .. i dl=0 s djstr=$p("000,031,059,090,120,151,181,212,243,273,304,334",",",dm),dj=djstr+dd 231 | .. i dl'=0 s djstr=$p("000,031,060,091,121,152,182,213,244,274,305,335",",",dm),dj=djstr+dd 232 | .. s x=(dy-1841)*365 233 | .. s y=(dy-1841)\4 234 | .. s mdate=dj+x+y 235 | .. i (dy>1900) s mdate=(mdate-1) 236 | .. i (dy'>1900) s mdate=mdate 237 | .. q 238 | . q 239 | q mdate 240 | ; 241 | dtime(mtime,format) ; decode M time 242 | n h,m,s 243 | i mtime="" q "" 244 | i mtime["," s mtime=$p(mtime,",",2) 245 | s h=mtime\3600,s=mtime-(h*3600),m=s\60,s=s#60 246 | q $s(h<10:"0",1:"")_h_":"_$s(m<10:"0",1:"")_m_":"_$s(s<10:"0",1:"")_s 247 | ; 248 | etime(dtime,format) ; encode M time 249 | n h,m,s 250 | i etime="" q "" 251 | s h=$p(dtime,":",1),m=$p(dtime,":",2),s=$p(dtime,":",3) 252 | q (h*3600)+(m*60)+s 253 | ; 254 | logerror(text,title) ; log error condition 255 | d logevent(text,title,"ERROR") ; log 256 | q 257 | ; 258 | logevent(record,title,context) ; log event 259 | s n=$i(^mglog) 260 | s ^mglog(n,0)=context_":"_title_":"_$$ddate($h)_"; "_$$dtime($h) 261 | s ^mglog(n,1)=record 262 | q 263 | ; 264 | logarray(array,title,context) ; log event 265 | s n=$i(^mglog) 266 | s ^mglog(n,0)=context_":"_title_":"_$$ddate($h)_"; "_$$dtime($h) 267 | m ^mglog(n,1)=array 268 | q 269 | ; 270 | -------------------------------------------------------------------------------- /yottadb/_mgsqlv.m: -------------------------------------------------------------------------------- 1 | %mqsqlv ;(CM) sql - validate query ; 28 Jan 2022 10:03 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlv") q 26 | ; 27 | main(dbid,line,sql,error) ; verify query 28 | k ^mgtmp($j) 29 | k %link,%delrec,union,adhoc,error 30 | s error="" 31 | s qnummax=$$main^%mgsqlp(.sql,.line,.error) i $l(error) g exit 32 | i '$d(sql(0,1)),$d(sql("txp",0)) s unique=1 g exit 33 | i '$d(sql(0,1)) s error="no sql script !!!",error(5)="HY000" g exit 34 | d upd(dbid,.sql,.error) i $l(error) g exit 35 | i $d(^mgtmp($j,"upd","delete")),hilev g exit 36 | i $p(sql(0,1)," ",1)="call" d sp(dbid,.sql,.error) g exit 37 | f qnum=1:1:qnummax d verify(dbid,.sql,qnum,.error) i $l(error) q 38 | i $l(error) g exit 39 | f qnum=1:1:qnummax s ^mgtmp($j,"subq",qnum)=qnummax-(qnum-1) 40 | i $d(%zq("drec",0)) d delrec i $l(error) g exit 41 | d unique 42 | s i="" f s i=$o(^mgtmp($j,"where",i)) q:i="" f j=1:1 q:'$d(^mgtmp($j,"where",i,j)) s x=^mgtmp($j,"where",i,j) i x[%z("dq") d sqidx 43 | i '$d(^mgtmp($j,"upd","insert")),'$d(^mgtmp($j,"from",1,1)) s error="no table to select 'from'",error(5)="HY000" g exit 44 | i '$d(^mgtmp($j,"upd","insert")),'$d(^mgtmp($j,"sel",1,1)) s error="no 'select' items",error(5)="HY000" g exit 45 | ; 46 | exit i $l(error) d error 47 | k ans,arg,bkt,cmnd,cod,com,cond,d,done,dx,dy,f,tname,alias,fr,fun,funk,i,ii,j,k,l,l1,l2,lc,lf,lin,num,os,p,rf,selarg,selct,ss1,ss2,to,typ,whct,x,y,z 48 | q 49 | ; 50 | sqidx ; index subqueries against parents 51 | s subq=$p(x,%z("dq"),2),x=^mgtmp($j,"where",i,j-1) 52 | s ^mgtmp($j,"sqcom",subq)=x 53 | i x="exists" s ^mgtmp($j,"ktmp",subq)="" q 54 | i x="not exists" s ^mgtmp($j,"ktmp",subq)="" q 55 | i x="in" s v=^mgtmp($j,"where",i,j-2),^mgtmp($j,"ktmp",subq)="",^mgtmp($j,"notnull",i,v)="",^mgtmp($j,"sqin",v)=subq q 56 | i x="not in" s v=^mgtmp($j,"where",i,j-2),^mgtmp($j,"ktmp",subq)="",^mgtmp($j,"notnull",i,v)="" q 57 | i $d(^mgtmp($j,"unique",subq)),'^mgtmp($j,"unique",subq) s ^mgtmp($j,"ktmp",subq)="" q 58 | q 59 | ; 60 | unique ; determine whether unique result is to be returned 61 | n outsel,agno,i,x,y 62 | i qnum=1,$d(update) s ^mgtmp($j,"unique",1)=1 q 63 | f i=1:1:qnum d 64 | . s outsel=$g(^mgtmp($j,"outsel",i))+0,agno=0 65 | . s x="" f s x=$o(^mgtmp($j,"sqag",i,x)) q:x="" s y="" f s y=$o(^mgtmp($j,"sqag",i,x,y)) q:y="" s agno=agno+1 66 | . i outsel=agno s ^mgtmp($j,"unique",i)=1 67 | . q 68 | i $d(^mgtmp($j,"group",1)) k ^mgtmp($j,"unique",1) q 69 | q 70 | ; 71 | error ; format error message 72 | n cmnd,qnum,ln 73 | s ln="",qnum="" 74 | i $d(error(1)) s cmnd=error(0),qnum=error(1) d error1 75 | i ln'="" s error("l")=ln 76 | q 77 | ; 78 | error1 ; look for line number 79 | n i,x 80 | i $d(^mgtmp($j,"cmnd",qnum,cmnd)) s ln=^(cmnd) q 81 | i $d(^mgtmp($j,"cmnd",0,cmnd,qnum)) s ln=^(qnum) q 82 | f i=1:1:$l(qnum,",") s x=$p(qnum,",",i) i $l(x),$d(^mgtmp($j,"cmnd",0,cmnd,x)) s ln=^(x) q 83 | q 84 | ; 85 | upd(dbid,sql,error) ; validate update directive 86 | n qnum,ln 87 | s qnum=0,ln=1 88 | i $p(sql(qnum,ln)," ",1)="update" d update^%mgsqlv3 i $l(error) q 89 | i $p(sql(qnum,ln)," ",1)="delete" d delete^%mgsqlv3 i $l(error) q 90 | i $p(sql(qnum,ln)," ",1)="insert" d insert^%mgsqlv4 i $l(error) q 91 | i $p(sql(qnum,ln)," ",1)="create" d create^%mgsqlv4(dbid,.sql,.error) q 92 | i $p(sql(qnum,ln)," ",1)="drop" d drop^%mgsqlv4(dbid,.sql,.error) q 93 | q 94 | ; 95 | sp(dbid,sql,error) ; stored procedure 96 | n qnum,ln,pname,r,ord,type,rou 97 | s qnum=0,ln=1 98 | s pname=$p(sql(qnum,ln)," ",2) 99 | s r=$$prc^%mgsqld(dbid,pname) 100 | s rou=$p(r,"\",2) 101 | s rc=$$pdata^%mgsqld(dbid,pname,.%data) 102 | s qnum=1 103 | s cname="" f s cname=$o(%data(cname)) q:cname="" d 104 | . s ord=$p(%data(cname),"\",1)+0 105 | . s type=$p(%data(cname),"\",2) 106 | . s ^mgtmp($j,"outsel",qnum,ord)=cname 107 | . q 108 | s ^mgtmp($j,"sp")=rou 109 | s error="\sp\" 110 | q 111 | ; 112 | verify(dbid,sql,qnum,error) ; verify current line 113 | n ln,cmnd,arg 114 | f ln=1:1 q:'$d(sql(qnum,ln)) i $p(sql(qnum,ln)," ",1)="from" q 115 | i '$d(sql(qnum,ln)) s error="missing/misplaced 'from' statement in (sub) query "_qnum,error(5)="HY000",error(0)="select",error(1)=qnum g verifyx 116 | s cmnd=$p(sql(qnum,ln)," ",1),arg=$p(sql(qnum,ln)," ",2,9999) 117 | i cmnd="from" d from^%mgsqlv5(dbid,.sql,qnum,arg,.error) i $l(error) g verifyx 118 | s ln=0 119 | verify1 s ln=ln+1 i '$d(sql(qnum,ln)) g verifyx 120 | s cmnd=$p(sql(qnum,ln)," ",1),arg=$p(sql(qnum,ln)," ",2,9999) 121 | i ln=1,cmnd'="select" s error="missing/misplaced 'select' statement in (sub) query "_qnum,error(5)="HY000",error(0)=cmnd,error(1)=qnum g verifyx 122 | i cmnd="order",$p(arg," ",1)="by" s arg=$p(arg," ",2,9999) 123 | i cmnd="group",$p(arg," ",1)="by" s arg=$p(arg," ",2,9999) 124 | i cmnd="select" d select^%mgsqlv2(dbid,.sql,qnum,.arg,.error) i $l(error) g verifyx 125 | i cmnd="where" d where^%mgsqlv1(dbid,.sql,qnum,.arg,.error) i $l(error) g verifyx 126 | i cmnd="order" d order^%mgsqlv2(dbid,.sql,qnum,.arg,.error) i $l(error) g verifyx 127 | i cmnd="group" d group^%mgsqlv2(dbid,.sql,qnum,.arg,.error) i $l(error) g verifyx 128 | i cmnd="having" d having^%mgsqlv2(dbid,.sql,qnum,.arg,.error) i $l(error) g verifyx 129 | g verify1 130 | verifyx i '$l(error),qnum=1,$d(sql("union",qnum)) s ^mgtmp($j,"sel",qnum,0)="distinct" 131 | q 132 | ; 133 | grp ; look for auto-group situation in outer query 134 | n x,y,z,com,agrp,ok,ln 135 | i qnum'=1 q 136 | i sql(qnum,1)["select *" q 137 | s ok=0 f ln=1:1 q:'$d(sql(qnum,ln)) i $p(sql(qnum,ln)," ",1)="group" s ok=1 q 138 | i ok q 139 | s z="",com="",agrp=0 f i=1:1 q:'$d(^mgtmp($j,"outsel",qnum,i)) s x=^mgtmp($j,"sel",1,i) i x[%z("dsv") s x=$p(x,%z("dsv"),2) s:x'?.1"."1a.e agrp=0 q:x'?.1"."1a.e s:x'["(" z=z_com_x,com="," s:x["(" agrp=1 140 | i 'agrp!'$l(z) q 141 | s z="group by "_z 142 | s sql(qnum,ln)=z 143 | q 144 | ; 145 | delrec ; validate the delete records declaration 146 | n alias,qnum 147 | s alias=$p(%zq("drec",0),":",1) 148 | f qnum=1:1 q:'$d(^mgtmp($j,"from","x",qnum)) i $d(^mgtmp($j,"from","x",qnum,alias)) s %zq("drec",0,alias)="" q 149 | i '$l($o(%zq("drec",0,""))) s error="alias '"_%zq("drec",0)_"' in 'delete_records' is not defined in the query",error(5)="HY000" q 150 | q 151 | ; 152 | trx(wrd) ; data translation 153 | n i,ii,arg,arg1,pre,post,type,cn,sqv 154 | s cn=$i(^mgtmp($j,"trx")),sqv="__evar"_cn 155 | s type="" f i=1:1 s type=$e(wrd,i) i type?1a q 156 | f i=2:1 s chr=$e(wrd,i) i chr=":"!(chr?1"""")!(chr?1"{")!(chr?1n)!(chr="") q 157 | f ii=$l(wrd)-1:-1:1 s chr=$e(wrd,ii) i chr?1""""!(chr?1"}")!(chr?1an)!(chr="") q 158 | s arg=$e(wrd,i,ii),pre=$e(wrd,1,i-1),post=$e(wrd,ii+1,9999) 159 | i arg?1":"1a.e s arg1=$e(arg,2,999) i arg1'="" s ^mgtmp($j,"in",arg1)="" 160 | s ^mgtmp($j,"trx",sqv)=chr 161 | s ^mgtmp($j,"trx",sqv,1)=arg 162 | q %z("dsv")_sqv_%z("dsv") 163 | ; 164 | -------------------------------------------------------------------------------- /yottadb/_mgsqlv1.m: -------------------------------------------------------------------------------- 1 | %mgsqlv1 ;(CM) sql - validate query part 2 ; 28 Jan 2022 10:03 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlv1") q 26 | ; 27 | addwhr(qnum,item) ; add item to where statement 28 | n wnum 29 | s wnum=$i(^mgtmp($j,"where",qnum)) 30 | s ^mgtmp($j,"where",qnum,wnum)=item 31 | q wnum 32 | ; 33 | where(dbid,sql,qnum,arg,error) ; validate 'where' statement 34 | n ln,wn,wnum,pred,wrd,word,ex 35 | s pred="" i $d(^mgtmp($j,"pred",qnum)) s pred=^(qnum) 36 | i $l(pred) s:$l(arg) arg=" and "_arg s arg="("_pred_")"_arg 37 | i $l(arg) s ex(1)=arg d where^%mgsqle(.ex,.word,.error) i $l(error) g wherex 38 | d link^%mgsqlv6(dbid,.sql,qnum,arg,.error) 39 | s wn=0 40 | where1 s wn=wn+1 i '$d(word(0,wn)) g wherex 41 | s wrd=word(0,wn) 42 | i wrd[%z("dsv") s wrd=$$where2(dbid,qnum,wrd,.error) i $l(error) g wherex 43 | i wrd[%z("df") s wrd=$$where3(qnum,$p(wrd,%z("df"),2),error) i $l(error) g wherex 44 | s wnum=$$addwhr(qnum,wrd) 45 | g where1 46 | wherex i $l(error),qnum?1n.n s error(0)="where",error(1)=qnum 47 | q 48 | ; 49 | where2(dbid,qnum,item,error) ; validate sql column 50 | n %d,%defk,%defd,%defm,x,y,z,wrd,typ,qnum1,fun,mfun,alias,tname,cname,alias,snum 51 | s wrd=item 52 | i qnum["g" g where2h 53 | s qnum1=qnum 54 | s x=$p(wrd,%z("dsv"),2) 55 | d corelate(.sql,qnum,x,.error) i $l(error) s error=error_": "_x q wrd 56 | ;;i x'["." s error="column '"_x_"' (in 'where'/'having' statement) is not qualified by table name/alias",error(5)="HY000" q wrd 57 | s cname=x,fun="" i x["(" s fun=$p(x,"(",1),x=$p(x,"(",2,999) i fun="count"&(x[" ") s fun="cntd",x=$p(x," ",2,999) 58 | s item=$p(x,")",1) 59 | d table^%mgsqlv2(dbid,qnum,item,.alias,.tname,.cname,1,.error) i $l(error) q wrd 60 | ;;s f=$p(x,".",1),(x,cname)=$p(x,".",2) 61 | s mfun=$$sqlfun^%mgsqlv2(fun) i mfun'="" s wrd=%z("df")_mfun_"("_alias_"."_cname_")"_%z("df") q wrd 62 | i $l(fun) s error="the 'where' statement must not contain references to sql aggregates",error(5)="HY000" q wrd 63 | i $d(sql("union",qnum)),'$d(^mgtmp($j,"from","x",qnum,alias)) s error="invalid alias '"_alias_"': 'union' queries cannot be correlated",error(5)="HY000" q wrd 64 | ;;f j=1:1:qnum q:'$d(^mgtmp($j,"from","x",j)) i $d(^mgtmp($j,"from","x",j,f)) s y=^mgtmp($j,"from","x",j,f),y=^mgtmp($j,"from",j,y),tname=$p(y,"~",1),alias=$p(y,"~",2) q wrd 65 | ;;i '$d(^mgtmp($j,"from","x",j,f)) s error="column '"_x_"' (in the 'where' statement) is qualified by an unknown table name/alias",error(5)="HY000" q wrd 66 | g where21 67 | where2h ; Having predicate 68 | s x=$p(wrd,%z("dsv"),2) 69 | i x="count(*)" s fun="count" g where23 70 | i x'["." s error="column '"_x_"' (in 'having' statement) is not qualified by table name/alias",error(5)="HY000" q 71 | s cname=x,fun="" i x["(" s fun=$p(x,"(",1),x=$p(x,"(",2,999) i fun="count"&(x[" ") s fun="cntd",x=$p(x," ",2,999) 72 | s item=$p(x,")",1) 73 | d table^%mgsqlv2(dbid,1,item,.alias,.tname,.cname,0,.error) i $l(error) q 74 | ;;s f=$p(x,".",1),(x,cname)=$p(x,".",2) 75 | i $d(sql("union",qnum)),'$d(^mgtmp($j,"from","x",qnum,alias)) s error="invalid alias '"_alias_"': 'union' queries cannot be correlated",error(5)="HY000" q 76 | ;;i $d(^mgtmp($j,"from","x",1,f)) s y=^mgtmp($j,"from","x",1,f),y=^mgtmp($j,"from",1,y),tname=$p(y,"~",1),alias=$p(y,"~",2) 77 | ;;i '$d(^mgtmp($j,"from","x",1,f)) s error="column '"_x_"' (in the 'having' statement) is qualified by an unknown table name/alias",error(5)="HY000" q 78 | where21 ; Common 79 | ;;i tname?@("1"""_%z("dq")_"""1n.n1"""_%z("dq")_"""") d q:$l(error) g where22 80 | ;;. n qnum 81 | ;;. s qnum=$p(tname,%z("dq"),2) 82 | ;;. i '$d(^mgtmp($j,"vx",qnum,x)) s error="column '"_x_"' ('where'/'having' statement) is not part of derived table "_alias,error(5)="42S22" q 83 | ;;. q 84 | s %defk=$$defk^%mgsqld(dbid,tname,cname),%defd=$$defd^%mgsqld(dbid,tname,cname),%defm=$$remap^%mgsqlv2(alias,cname) i '%defk,'%defd,'%defm s error="column '"_item_"' ('where'/'having' statement) is not part of table "_tname,error(5)="42S22" q wrd 85 | s %d=$$col^%mgsqld(dbid,tname,cname) s typ=$p(%d,"\",11) 86 | where22 s item=%z("dsv")_alias_"."_cname_%z("dsv"),snum=$$addselx^%mgsqlv2(qnum,item) s ^mgtmp($j,"wsel",item)="" 87 | i fun="" q item 88 | where23 i "count,cntd,sum,avg,max,min"'[fun q wrd 89 | s qnum1=qnum+0 90 | i x="count(*)" s z="*"_qnum1,wrd=%z("dsv")_"count("_"*"_qnum1_")"_%z("dsv") 91 | i x'="count(*)" s z=alias_"."_x 92 | s y=%z("dsv")_fun_"("_z_")"_%z("dsv") 93 | i fun["(" s y=y_")" 94 | s snum=$$addselx^%mgsqlv2(qnum1,y) 95 | s ^mgtmp($j,"wsel",y)="" 96 | i '$d(^mgtmp($j,"sqag",qnum1,z,fun)) s ^mgtmp($j,"sqag",qnum1,z,fun)=snum 97 | q wrd 98 | ; 99 | where3(qnum,mfun,error) ; embedded functions in 'where' statement 100 | n pn,i,fn,ax,outv,ex,word,zcode,fun,item,snum 101 | s ax=$g(^mgtmp($j,"e"))+1,^("e")=ax 102 | s outv="___v"_ax 103 | s ex(1)=mfun d ex^%mgsqle(outv,.ex,.word,.zcode,.fun,.error) i $l(error) q "" 104 | f fn=1:1 q:'$d(fun(fn)) f pn=1:1 q:'$d(fun(fn,"p",pn)) s item=$g(fun(fn,"p",pn,1)) i item[%z("dsv") s snum=$$addselx^%mgsqlv2(qnum,item) 105 | f i=1:1 q:'$d(zcode(i)) f q:zcode(i)'[%z("df") d 106 | . s fn=$p(zcode(i),%z("df"),2) 107 | . s zcode(i)=$p(zcode(i),%z("df"),1)_fun(fn,"s")_$p(zcode(i),%z("df"),3,999) 108 | . q 109 | m ^mgtmp($j,"e",outv)=zcode 110 | s item=%z("dsv")_outv_%z("dsv"),snum=$$addselx^%mgsqlv2(qnum,item) 111 | q (%z("dsv")_outv_%z("dsv")) 112 | ; 113 | corelate(sql,qnum,item,error) ; determine if sql variable comes from different sub-query 114 | n i,alias 115 | s alias=$p(item,".",1) i alias="" q 116 | i $d(^mgtmp($j,"from","x",qnum,alias)) q 117 | f i=1:1 q:'$d(^mgtmp($j,"from","x",i)) i $d(^mgtmp($j,"from","x",i,alias)) q 118 | i '$d(^mgtmp($j,"from","x",i,alias)) q 119 | i $d(sql("union",qnum)),$d(sql("union",i)) s error="'union' (sub) queries may not be correlated",error(5)="HY000" q 120 | s ^mgtmp($j,"corel",i,qnum,alias)="",^mgtmp($j,"corelx",qnum,i,alias)="",^mgtmp($j,"corel",i,qnum)=0 121 | s ^mgtmp($j,"corel",i,qnum,alias,x)="" 122 | q 123 | ; 124 | -------------------------------------------------------------------------------- /yottadb/_mgsqlv3.m: -------------------------------------------------------------------------------- 1 | %mgsqlv3 ;(CM) sql - validate query part 4 ; 28 Jan 2022 10:03 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlv3") q 26 | ; 27 | update ; validate 'update' query 28 | n ln 29 | s upd=sql(0,1),set=sql(0,2),ats="" 30 | s tname=$p(upd," ",2),alias=$p(upd," ",3) i tname="" s error="no table supplied in 'update' statement",error(5)="HY000" g updatex 31 | s updidx="" i alias?.e1":"1n.n s updidx=":"_$p(alias,":",2),alias=$p(alias,":",1) 32 | i '$l(alias) s alias=tname 33 | i $l(alias),alias'?1a.e s error="invalid alias '"_alias_"'",error(5)="HY000" g updatex 34 | s %d=$$tab^%mgsqld(dbid,tname) i %d="" s error="no such table '"_tname_"'",error(5)="42S02" g updatex 35 | s incwhr=0 36 | s scmnd=$p(set," ",1),set=$p(set," ",2,999) 37 | i scmnd="columns" d at i $p(sql(0,1)," ",1)="insert" q 38 | i scmnd="set" d set i $l(error) g updatex 39 | s (x,sel,com)="" k y 40 | f i=0:0 s x=$o(^mgtmp($j,"upd","set",x)) q:x="" s sel=sel_com_x,com=",",y(x)="",y="" f i=0:0 s y=$o(^mgtmp($j,"upd","set",x,"i",y)) q:y="" i '$d(y(y)) s sel=sel_com_y,y(y)="" 41 | k y 42 | s sql(1,1)="select "_sel,sql(1,2)="from "_tname i $l(alias) s sql(1,2)=sql(1,2)_" "_alias_updidx 43 | i '$l(ats) d update1 k wrd,wrdx i ins q 44 | s ^mgtmp($j,"upd","update")=tname,^mgtmp($j,"upd","set")=set i $l(alias) s ^mgtmp($j,"upd","update")=^mgtmp($j,"upd","update")_" "_alias 45 | updatex i $l(error),'$d(error(0)) s error(0)="update",error(1)=0 46 | k upd,set 47 | q 48 | ; 49 | at ; validate 'columns' line and transform to 'insert' if neccessary 50 | s ats=set i ats'?1"("1a.e1")" s error="invalid 'columns' statement",error(5)="HY000" g atx 51 | s ats=$e(ats,2,$l(ats)-1) 52 | s tnamer=tname 53 | k pkey s ino=$$pkey^%mgsqld(dbid,tname) s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) f i=1:1 q:'$d(%ind(ino,i)) s x=%ind(ino,i) k %ind(ino,i) i x?1a.e s pkey(x)="" 54 | f i=1:1:$l(ats,",") s xc=$p(ats,",",i) d at1 i $l(error) q 55 | i $l(error) g atx 56 | s (x,com,pkey)="" f i=0:0 s x=$o(pkey(x)) q:x="" s pkey=pkey_com_x 57 | i $l(pkey) s error="key column(s) "_pkey_" not found in 'columns' statement",error(5)="HY000" g atx 58 | i $d(sql(1,3)) g atx 59 | k sql 60 | s qnummax=0 61 | s sql(0,1)="insert" 62 | s sql(0,2)="into "_tname_" (" 63 | s sql(0,3)="values (" 64 | s x="",com="" f i=0:0 s x=$o(^mgtmp($j,"upd","set",x)) q:x="" s sql(0,2)=sql(0,2)_com_x,sql(0,3)=sql(0,3)_com_^mgtmp($j,"upd","set",x),com="," 65 | f i=2,3 s sql(0,i)=sql(0,i)_")" 66 | atx i $l(error) s error(0)="columns",error(1)=0 67 | q 68 | ; 69 | at1 ; validate column 70 | i xc="" s error="syntax error in 'columns' statement",error(5)="HY000" q 71 | i xc'?1a.e!($l(xc,",")>2) s error="invalid column '"_xc_"' in 'columns' statement",error(5)="HY000" q 72 | s cname=$p(xc,";",1) 73 | s %defk=$$defk^%mgsqld(dbid,tname,cname),%defd=$$defd^%mgsqld(dbid,tname,cname) i '%defk,'%defd s error="column '"_cname_"' not found in table '"_tname_"'",error(5)="42S22" q 74 | i tname?@("1"""_%z("dq")_"""1n.n1"""_%z("dq")_"""") d q:$l(error) g at11 75 | . n qnum 76 | . ;b 77 | . s qnum=$p(tname,%z("dq"),2) 78 | . i '$d(^mgtmp($j,"vx",qnum,cname)) s error="column '"_cname_"' is found in derived table "_alias,error(5)="42S22" q 79 | . q 80 | at11 k pkey(cname) s ^mgtmp($j,"upd","set",cname)=":"_xc,^mgtmp($j,"upd","set",cname,"zcode",1)=" s "_%z("dsv")_cname_"**set**"_%z("dsv")_"="_%z("dev")_xc_%z("dev"),inv(xc)="" 81 | q 82 | ; 83 | set ; validate 'set' statement 84 | n arg,args 85 | s arg=set s arg=$$arg^%mgsqle(arg,.args) 86 | f i=1:1:args s x=args(i) d set1 i $l(error) q 87 | i $l(error) s error(0)="set",error(1)=0 88 | q 89 | ; 90 | set1 ; validate individual 'set' in 'set' statement 91 | n i,outv,zcode,word 92 | s to=$p(x," ",3,999),outv=$p(x," ",1) 93 | s cname=outv i outv?1a.e1"."1a.e s cname=$p(outv,".",2) i $p(outv,".",1)'=alias s error="'set' statement: incorrect alias in '"_outv_"'",error(5)="HY000" q 94 | i $p(x," ",2)'="="!(cname="")!(to="") s error="invalid assignment: '"_x_"'",error(5)="HY000" q 95 | i tname?@("1"""_%z("dq")_"""1n.n1"""_%z("dq")_"""") d q:$l(error) g set11 96 | . n qnum 97 | . ;b 98 | . s qnum=$p(tname,%z("dq"),2) 99 | . i '$d(^mgtmp($j,"vx",qnum,cname)) s error="column '"_cname_"' in 'set' statement not found in derived table "_alias,error(5)="42S22" q 100 | . q 101 | s %defk=$$defk^%mgsqld(dbid,tname,cname),%defd=$$defd^%mgsqld(dbid,tname,cname) i '%defk,'%defd s error="column '"_cname_"' in 'set' statement not found in table '"_tname_"'",error(5)="42S22" q 102 | set11 d set2 i $l(error) q 103 | s ^mgtmp($j,"upd","set",cname)=to 104 | f i=1:1 q:'$d(zcode(i)) s ^mgtmp($j,"upd","set",cname,"zcode",i)=zcode(i) 105 | s x="" f i=0:0 s x=$o(word("sqv","x",x)) q:x="" s ^mgtmp($j,"upd","set",cname,"i",x)="" 106 | q 107 | ; 108 | set2 ; compile set assignment 109 | ; cm: add %z 110 | n (%z,dbid,qid,error,to,outv,inv,entpar,del,zcode,word) 111 | k zcode,word 112 | s outv=outv_"**set**" 113 | s l=1,ex(1)=to d ex^%mgsqle(outv,.ex,.word,.zcode,.fun,.error) 114 | q 115 | ; 116 | update1 ; determine if transformation into 'insert' is necessary 117 | s ins=1 118 | i '$d(sql(1,3)) s ins=0 q 119 | f i=1:1:$l(set,",") s x=$p(set,",",i),cname=$p(x," ",1) s:cname?1a.e1"."1a.e cname=$p(cname,".",2) i $l(cname) s wrdx(cname)=$p(x," ",3,999),ino=$$pkey^%mgsqld(dbid,tname) s %def=$$defkdi^%mgsqld(dbid,tname,cname,ino) i %def s ins=0 q 120 | i 'ins q 121 | s ln=$p(sql(1,3)," ",2,999) 122 | d update2 k pkey i 'uni!'uni(0) s ins=0 q 123 | k sql 124 | s qnummax=0 125 | s sql(0,1)="insert" 126 | s sql(0,2)="into "_tname_" (" 127 | s sql(0,3)="values (" 128 | s com="",x="" f i=0:0 s x=$o(wrdx(x)) q:x="" s sql(0,2)=sql(0,2)_com_x,sql(0,3)=sql(0,3)_com_wrdx(x),com="," 129 | f i=2,3 s sql(0,i)=sql(0,i)_")" 130 | q 131 | ; 132 | update2 ; determine unique restriction for table tname (on primary key) 133 | n exp,eq,pkeyn 134 | s uni=1,uni(0)=0 i '$l(ln) s uni=0 q 135 | k pkey s ino=$$pkey^%mgsqld(dbid,tname),pkeyn=0 s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) f i=1:1 q:'$d(%ind(ino,i)) s x=%ind(ino,i) k %ind(ino,i) i x?1a.e s pkeyn=pkeyn+1,pkey(x)="" 136 | s exp=ln d eq 137 | s x="" f i=1:1 s x=$o(eq(x)) q:x="" s wrdx(x)=eq(x) k pkey(x) 138 | i pkeyn=(i-1) s uni(0)=1 139 | i $d(pkey) s (uni,uni(0))=0 140 | q 141 | ; 142 | delete ; delete records 143 | n %om,exp,eq 144 | s dele=sql(0,1),frm=sql(1,2),exp=$s($d(sql(1,3)):sql(1,3),1:"") 145 | i $l($p(dele,"delete",2,999)) s error="the 'delete' statement does not take an argument",error(5)="HY000",error(0)="delete",error(1)=0 q 146 | s tname=$p(frm," ",2),alias=$p(frm," ",3) i tname="" s error="no table supplied in 'from' statement",error(5)="HY000",error(0)="from",error(1)=0 q 147 | i alias="" s alias=tname 148 | i $l(exp),exp'?1"where ".e s error="invalid 'where' statement following the 'from' statement",error(5)="HY000",error(0)="from",error(1)=0 q 149 | i $l(exp) s exp=$p(exp,"where ",2,999) 150 | i $l(alias),alias'?1a.e s error="invalid alias '"_alias_"'",error(5)="HY000",error(0)="from",error(1)=0 q 151 | s %d=$$tab^%mgsqld(dbid,tname) i %d="" s error="no such table '"_tname_"'",error(5)="42S02",error(0)="from",error(1)=0 q 152 | s incwhr=0 153 | i tname?1a.e s rc=$$ind^%mgsqld(dbid,tname,.%ind) s ino="" f i=0:0 s ino=$o(%ind(ino)) q:ino="" s sc=$$key^%mgsqld(dbid,tname,ino,.%ind) 154 | d delete1 i $l(error) q 155 | i hilev k sql(1) g deletex 156 | s (com,sel)="",ino=$$pkey^%mgsqld(dbid,tname) 157 | f i=1:1 q:'$d(%ind(ino,i)) s x=%ind(ino,i) k %ind(ino,i) i x?1a.e s sel=sel_com_x,com="," 158 | i sel="" s error="no key columns found in table '"_tname_"'",error(5)="HY000",error(0)="from",error(1)=0 q 159 | s sql(1,1)="select "_sel 160 | s ^mgtmp($j,"upd","key")=sel 161 | deletex s ^mgtmp($j,"upd","delete")=tname i $l(alias) s ^mgtmp($j,"upd","delete")=^mgtmp($j,"upd","delete")_" "_alias 162 | k dele,frm,whe,x,sel,tname,com 163 | q 164 | ; 165 | delete1 ; assess possibility of doing high level kill 166 | s hilev=0 q ; don't do this for now 167 | i '$l(exp) s hilev=1 q 168 | d eq i $l(error) s error="",hilev=0 q 169 | i 'eq q 170 | s hilev=1,ino="" f i=0:0 s ino=$o(%ind(ino)) q:ino="" d delete2 i 'hilev q 171 | i 'hilev q 172 | s cname="" f i=0:0 s cname=$o(eq(cname)) q:cname="" s ^mgtmp($j,"upd","attx",cname)=eq(cname,"c") 173 | q 174 | ; 175 | delete2 ; each index must conform to hilev criteria 176 | s kno=0 f i=1:1 q:'$d(%ind(ino,i)) s cname=%ind(ino,i) i cname?1a.e q:'$d(eq(cname)) s kno=kno+1 177 | i kno'=eq s hilev=0 q 178 | q 179 | ; 180 | eq ; extract contiguous equivalence table 181 | n word,ex 182 | k eq s eq=0 183 | s ex(1)=exp d where^%mgsqle(.ex,.word,.error) i $l(error) k eq s eq=0 q 184 | k eq s eq=0 185 | s ok=1 f wn=1:1 q:'$d(word(0,wn)) s wrd=word(0,wn) d eq1 i 'ok k eq s eq=0 q 186 | q 187 | ; 188 | eq1 ; verify each word 189 | n obr,cbr,set,setc,to,alias 190 | i wrd="or"!(wrd="!") s ok=0 q 191 | i wrd[%z("df") s ok=0 q 192 | i wrd'[%z("dsv") q 193 | s wrd=$p(wrd,%z("dsv"),2),alias="" i wrd["." s alias=$p(wrd,".",1),wrd=$p(wrd,".",2) 194 | i '$d(word(0,wn+1))!'$d(word(0,wn+2)) s ok=0 q 195 | i word(0,wn+1)'="=" s ok=0 q 196 | s to=word(0,wn+2) i to'="(" s (set,setc)=to s:set[%z("dev") set=":"_$p(set,%z("dev"),2) g eq2 197 | s (obr,cbr)=0,(set,setc)="" f wn1=wn+2:1 q:'$d(word(0,wn1)) s (x,y)=word(0,wn1) s:x="(" obr=obr+1 s:x=")" cbr=cbr+1 s:x[%z("dev") x=":"_$p(x,%z("dev"),2) s set=set_x,setc=setc_y i obr=cbr q 198 | i set[%z("dsv") s ok=0 q 199 | eq2 s eq(wrd)=set,eq(wrd,"c")=setc,eq(wrd,"f")=alias,eq=eq+1,wn=wn+2 200 | q 201 | ; 202 | asn ; extract universal statement assignments 203 | n dead,word,ex 204 | k eq1 s eq1=0 ; equals + others - or 205 | s ex(1)=exp d where^%mgsqle(.ex,.word,.error) i $l(error) q 206 | f wn=1:1 q:'$d(word(0,wn)) s wrd=word(0,wn) i wrd="!" d asn1 207 | f wn=1:1 q:'$d(word(0,wn)) s wrd=word(0,wn) i wrd="=",'$d(dead(wn)) d asn2 208 | q 209 | ; 210 | asn1 ; remove or + affected variables 211 | n strt,end,i,obr,cbr,x 212 | s strt=wn,(obr,cbr)=0 f i=wn-1:-1 q:'$d(word(0,i)) s x=word(0,i),strt=i s:x="(" obr=obr+1 s:x=")" cbr=cbr+1 i obr=(cbr+1) q 213 | s end=wn,(obr,cbr)=0 f i=wn+1:1 q:'$d(word(0,i)) s x=word(0,i),end=i s:x="(" obr=obr+1 s:x=")" cbr=cbr+1 i cbr=(obr+1) q 214 | f i=strt:1:end s dead(i)="" 215 | q 216 | ; 217 | asn2 ; extract assignment 218 | n obr,cbr,set,setc,to,alias,wrd 219 | i '$d(word(0,wn-1)) q 220 | s wrd=word(0,wn-1) i wrd'[%z("dsv") q 221 | s wrd=$p(wrd,%z("dsv"),2),alias="" i wrd["." s alias=$p(wrd,".",1),wrd=$p(wrd,".",2) 222 | i '$d(word(0,wn+1)) q 223 | s to=word(0,wn+1) i to'="(" s (set,setc)=to s:set[%z("dev") set=":"_$p(set,%z("dev"),2) g asn21 224 | s (obr,cbr)=0,(set,setc)="" f wn1=wn+1:1 q:'$d(word(0,wn1)) s (x,y)=word(0,wn1) s:x="(" obr=obr+1 s:x=")" cbr=cbr+1 s:x[%z("dev") x=":"_$p(x,%z("dev"),2) s set=set_x,setc=setc_y i obr=cbr q 225 | i set[%z("dsv") q 226 | asn21 s eq1(wrd)=set,eq1(wrd,"c")=setc,eq1(wrd,"f")=alias,eq1=eq1+1 227 | q 228 | ; 229 | -------------------------------------------------------------------------------- /yottadb/_mgsqlv5.m: -------------------------------------------------------------------------------- 1 | %mgsqlv5 ;(CM) sql - validate query - part 6 ; 28 Jan 2022 10:03 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlv5") q 26 | ; 27 | from(dbid,sql,qnum,arg,error) ; validate 'from' statement 28 | n tnum,nord,xord,i,x,tname,alias,args,index,on 29 | s ^mgtmp($j,"from","i","x",qnum)=0 30 | s arg=$$arg^%mgsqle(arg,.args) 31 | s tnum=0 f i=1:1:args s tname=args(i) i tname'="" d from1(dbid,qnum,.tnum,tname) i $l(error) q 32 | i '$l(error) s ^mgtmp($j,"from",qnum)=arg 33 | fromx i $l(error) s error(0)="from",error(1)=qnum q 34 | s x="" f s x=$o(^mgtmp($j,"from","z",qnum,"jn",x)) q:x="" d natv(dbid,qnum,x,.error) i $l(error) q 35 | i $l(error) q 36 | s x="" f s x=$o(^mgtmp($j,"from","z",qnum,"c",0,x)) q:x="" s ^mgtmp($j,"from","z",qnum,"c","x",$p(^mgtmp($j,"from",qnum,x),"~",2))="",^mgtmp($j,"from","z",qnum,"c","x",$p(^mgtmp($j,"from",qnum,x+1),"~",2))="" 37 | s xord=1 s x=$o(^mgtmp($j,"from","z",qnum,"o",0,"")) i $l(x),^mgtmp($j,"from","z",qnum,"o",0,x)="right" s xord=-1 38 | s nord=0 39 | s x="" f s x=$o(^mgtmp($j,"from","z",qnum,"o",0,x),xord) q:x="" d from4(x,xord,.nord) 40 | f nord=1:1 q:'$d(^mgtmp($j,"from","z",qnum,"ord",nord)) s x=^mgtmp($j,"from","z",qnum,"ord",nord),^mgtmp($j,"from","z",qnum,"ord",nord)=$p(^mgtmp($j,"from",qnum,x),"~",2) 41 | fromxx ; compile 'on' predicates 42 | f i=1:1 q:'$d(^mgtmp($j,"from","on",qnum,i)) s on=$g(^mgtmp($j,"from","on",qnum,i)) d i $l(error) q 43 | . n qnumo 44 | . s qnumo=qnum_"gon"_i d where^%mgsqlv1(dbid,sql,qnumo,on,.error) i $l(error) q 45 | . q 46 | q 47 | ; 48 | from1(dbid,qnum,tnum,tname) ; validate each table selected from 49 | n %ref,i,ii,j,x,y,z,z1,zz,ino,inof,inop,exp,pn,nat,jtyp,ok,com 50 | f x="inner","left","right","full" s jtyp(x)="" 51 | s (exp,pn,obr,cbr)=0,y="",com="" f i=1:1:$l(tname," ") s x=$$trim^%mgsqls($p(tname," ",i)," ") i $l(x) d 52 | . i x["(" s obr=obr+1 53 | . i x[")" s cbr=cbr+1 54 | . s y=y_com_x,com=" " 55 | . i obr=cbr s exp=exp+1,exp(exp)=y,y="",com="",(obr,cbr)=0 56 | . q 57 | f i=1:1 q:'$d(exp(i)) i exp(i)="on" d 58 | . i '$d(exp(i+1)) q 59 | . i exp(i+1)?1"(".e q 60 | . s x="(",com="" f ii=i+1:1 q:'$d(exp(ii)) s y=exp(ii) i y'="" q:$d(jtyp(y))!(y="join")!(y="natural")!(y="inner")!(y="cross") s x=x_com_y,com=" " k exp(ii) 61 | . s x=x_")" 62 | . s j=i+1,exp(j)=x 63 | . f ii=ii:1 q:'$d(exp(ii)) s x=exp(ii) k exp(ii) s j=j+1,exp(j)=x 64 | . q 65 | from11 s pn=pn+1 i '$d(exp(pn)) q 66 | s tname=exp(pn),nat=0 67 | s alias=tname i alias["." s alias=$p(tname,".",2) 68 | s pn=pn+1 i '$d(exp(pn)) g from16 69 | s x=exp(pn) 70 | i x="join" g from14 71 | i x="natural" s nat=1 g from12 72 | i x="cross" g from12 73 | i $d(jtyp(x)) s y=x g from12a 74 | s alias=x 75 | s pn=pn+1 i '$d(exp(pn)) g from16 76 | s x=exp(pn) 77 | i x="join" g from14 78 | i x="natural" s nat=1 g from12 79 | i x="cross" g from12 80 | i $d(jtyp(x)) s y=x g from12a 81 | s alias=x 82 | s pn=pn+1 i '$d(exp(pn)) g from16 83 | s x=exp(pn) 84 | i x="join" g from14 85 | i x="natural" s nat=1 g from12 86 | i x="cross" g from12 87 | i $d(jtyp(x)) s y=x g from12a 88 | s error="joins should be specified as [natural] or join or cross join",error(5)="HY000" q 89 | from12 ; join expression 90 | s pn=pn+1 i '$d(exp(pn)) s error="'from' declaration may not be terminated with '"_x_"'",error(5)="HY000" q 91 | s y=exp(pn) 92 | i x="cross",y'="join" s error="keyword 'cross' must be followed by 'join'",error(5)="HY000" q 93 | i x="cross",y="join" g from13 94 | i x="natural",y="join" g from14 95 | from12a i '$d(jtyp(y)) s error="invalid join type '"_y_"' use inner,left, right or full",error(5)="HY000" q 96 | s pn=pn+1 i '$d(exp(pn)) s error="'from' declaration must not be terminated with '"_y_"'",error(5)="HY000" q 97 | s z=exp(pn) 98 | i y="inner",z'="join" s error="keyword 'inner' should be followed by 'join'",error(5)="HY000" q 99 | i y="inner",z="join" g from14 100 | i z="join" g from15 101 | i z'="outer" s error="keyword left|right|full should be followed by outer or join",error(5)="HY000" q 102 | s pn=pn+1 i '$d(exp(pn)) s error="'from' declaration cannot be terminated with '"_z_"'",error(5)="HY000" q 103 | s z1=exp(pn) i z1'="join" s error="keyword 'outer' must be followed by 'join'",error(5)="HY000" q 104 | g from15 105 | from13 ; cartesian product 106 | s ^mgtmp($j,"from","z",qnum,"c",0,tnum+1)="" 107 | g from16 108 | from14 ; inner join 109 | s ^mgtmp($j,"from","z",qnum,"i",0,tnum+1)="" 110 | d nat(dbid,qnum,tnum,tname,nat,.exp,.error) 111 | g from16 112 | from15 ; outer join 113 | s n="" f s n=$o(^mgtmp($j,"from","z",qnum,"o",0,n)) q:n="" i ^mgtmp($j,"from","z",qnum,"o",0,n)'=y s error="express all outer joins as either 'left', 'right' or 'full'",error(5)="HY000" q 114 | i $l(error) q 115 | s ^mgtmp($j,"from","z",qnum,"o",0,tnum+1)=y 116 | d nat(dbid,qnum,tnum,tname,nat,.exp,.error) 117 | from16 ; process table/alias 118 | s inof="" 119 | i tname[" " s alias=$p(tname," ",2) s:'$l(alias) error="invalid component '"_tname_"' in 'from' statement",error(5)="HY000" q:$l(error) s tname=$p(tname," ",1) 120 | i tname["." s dbid=$p(tname,".",1),tname=$p(tname,".",2) 121 | i tname[":" s inof=$p(tname,":",2),tname=$p(tname,":",1) 122 | i '$l(dbid) s error="invalid 'from' statement",error(5)="HY000" q 123 | i '$l(tname) s error="invalid 'from' statement",error(5)="HY000" q 124 | s (ino,inop)=$$pkey^%mgsqld(dbid,tname) 125 | i alias[":" s inof=$$from3(qnum,.alias) 126 | i inof'="" s:inof="0" inof=inop s ino=inof 127 | s ok=$$fromv(dbid,tname,.error) i $l(error) q 128 | f ii=1:1 q:'$d(^mgtmp($j,"from","x",ii)) i $d(^mgtmp($j,"from","x",ii,alias)) s error="query contains duplication of table/alias '"_alias_"'",error(5)="HY000" q 129 | i $l(error) q 130 | s %ref=$$ref^%mgsqld(dbid,tname,ino) i %ref="" s error="invalid index name '"_ino_"' for table '"_tname_"'",error(5)="HY000" q 131 | s tnum=tnum+1,^mgtmp($j,"from",qnum,tnum)=tname_"~"_alias,^mgtmp($j,"from","x",qnum,tname)=tnum,^mgtmp($j,"from","x",qnum,alias)=tnum 132 | s ^mgtmp($j,"from","i",0,alias)=ino i inof'="" s ^mgtmp($j,"from","i","f",$s(alias'="":alias,1:tname))=inof 133 | g from11 134 | ; 135 | from3(qnum,alias) ; index specification 136 | n x,ino 137 | s x=$p(alias,":",2,999),alias=$p(alias,":",1) 138 | s ino=x,ino=$p(x,"(",1),^mgtmp($j,"from","i","x",qnum)=1 139 | q ino 140 | ; 141 | from4(fnum,xord,nord) ; outer join mandatory running order 142 | n fnum1,fnum2 143 | i xord=1 s fnum1=fnum,fnum2=fnum+1 144 | i xord=-1 s fnum1=fnum+1,fnum2=fnum 145 | s ^mgtmp($j,"from","z",qnum,"pass",$p(^mgtmp($j,"from",qnum,fnum2),"~",2))="" 146 | i '$d(^mgtmp($j,"from","z",qnum,"ordx",fnum1)) s nord=nord+1,^mgtmp($j,"from","z",qnum,"ord",nord)=fnum1,^mgtmp($j,"from","z",qnum,"ordx",fnum1)="" 147 | i '$d(^mgtmp($j,"from","z",qnum,"ordx",fnum2)) s nord=nord+1,^mgtmp($j,"from","z",qnum,"ord",nord)=fnum2,^mgtmp($j,"from","z",qnum,"ordx",fnum2)="" 148 | q 149 | ; 150 | fromv(dbid,tname,error) ; validate table 151 | n %d 152 | s %d=$$tab^%mgsqld(dbid,tname) i %d="" s error="no such table '"_tname_"'",error(5)="42S02" q 0 153 | q 1 154 | ; 155 | nat(dbid,qnum,tnum,tname,nat,exp,error) ; extract join parameters 156 | n i,ii,x,cname,alias,on,onexp 157 | i nat q ; data dictionary 158 | s on="" 159 | f i=pn+1:1 q:'$d(exp(i)) s x=exp(i) i x="using"!(x="on") s on=x q 160 | i on="" s error="if a join is not natural then qualify it with either an 'on' or 'using' statement",error(5)="HY000" q 161 | i '$d(exp(i+1)) s error="missing parameter(s) for 'on'/'using' statement",error(5)="HY000" q 162 | i on="on" g naton 163 | s x=exp(i+1) 164 | i x'?1"("1e.e1")" s error="syntax error in parameters to 'using' statement",error(5)="HY000" q 165 | s x=$p($p(x,"(",2),")",1) 166 | f ii=1:1:$l(x,",") s cname=$$trim^%mgsqls($p(x,",",ii)," ") i $l(cname) s ^mgtmp($j,"from","z",qnum,"jn",tnum+1,cname)="" 167 | i '$d(^mgtmp($j,"from","z",qnum,"jn",tnum+1)) s error="no valid parameters for 'using' statement found",error(5)="HY000" q 168 | k exp(i),exp(i+1) f i=i+2:1 q:'$d(exp(i)) s exp(i-2)=exp(i) k exp(i) 169 | q 170 | naton ; 'on' statement 171 | s x=exp(i+1) 172 | i x?1"("1e.e1")" s x=$p($p(x,"(",2),")",1) 173 | ; cmtxxx 174 | d where^%mgsqle(x,.onexp,.error) i error'="" q 175 | s ^mgtmp($j,"from","on",qnum,$i(^mgtmp($j,"from","on",qnum)))=x 176 | ; cmtxxx 177 | ;f ii=1:1:$l(x," ") s cname=$$trim^%mgsqls($p(x," ",ii)," "),alias=$p(cname,".",1),cname=$p(cname,".",2) i cname'="",alias'="" s ^mgtmp($j,"from","z",qnum,"join",cname,alias)="" 178 | s ii="" f s ii=$o(onexp("sqv",0,"x",ii)) q:ii="" s alias=$p(ii,".",1),cname=$p(ii,".",2) i cname'="",alias'="" s ^mgtmp($j,"from","z",qnum,"join",cname,alias)="" 179 | k exp(i),exp(i+1) f i=i+2:1 q:'$d(exp(i)) s exp(i-2)=exp(i) k exp(i) 180 | q 181 | ; 182 | natv(dbid,qnum,tnum,error) ; validate element in using statement 183 | n tname,tname1,tname2,alias,alias1,alias2,cname 184 | s tname1=$p(^mgtmp($j,"from",qnum,tnum),"~",1),alias1=$p(^mgtmp($j,"from",qnum,tnum),"~",2) 185 | s tname2=$p(^mgtmp($j,"from",qnum,tnum+1),"~",1),alias2=$p(^mgtmp($j,"from",qnum,tnum+1),"~",2) 186 | s cname="" f s cname=$o(^mgtmp($j,"from","z",qnum,"jn",tnum,cname)) q:cname="" d natv1(dbid,qnum,tname1,tname2,cname,.error) i $l(error) q 187 | i $l(error) q 188 | s ^mgtmp($j,"from","z",qnum,"c","x",alias1)="",^mgtmp($j,"from","z",qnum,"c","x",alias2)="" 189 | k ^mgtmp($j,"from","z",qnum,"jn",tnum) 190 | q 191 | ; 192 | natv1(dbid,qnum,tname1,tname2,cname,error) ; column in tables test 193 | n %defk,%defd 194 | f tname=tname1,tname2 s %defk=$$defk^%mgsqld(dbid,tname,cname),%defd=$$defd^%mgsqld(dbid,tname,cname) i '%defk,'%defd s error="'using' statement: column '"_cname_"' not found in table '"_tname_"'",error(5)="42S22" q 195 | i $l(error) q 196 | s ^mgtmp($j,"from","z",qnum,"join",cname,alias1)="",^mgtmp($j,"from","z",qnum,"join",cname,alias2)="" 197 | q 198 | ; 199 | -------------------------------------------------------------------------------- /yottadb/_mgsqlv6.m: -------------------------------------------------------------------------------- 1 | %mgsqlv6 ;(CM) sql - set expansion ; 28 Jan 2022 10:03 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlv6") q 26 | ; 27 | link(dbid,sql,qnum,arg,error) ; expand where statement 28 | q 29 | ; 30 | -------------------------------------------------------------------------------- /yottadb/_mgsqlw.m: -------------------------------------------------------------------------------- 1 | %mgsqlw ;(CM) MGSQL HTTP ; 28 Jan 2022 10:04 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlw") q 26 | ; 27 | main ; start 28 | n %zi,%zo,dbid,head,ok,cgi,data,nvp,error 29 | new $ztrap set $ztrap="zgoto "_$zlevel_":loope^%mgsqlw" 30 | k ^mgtmp($j) 31 | s dbid=$$init(.%zi) 32 | s head=buf 33 | loop ; next command 34 | new $ztrap set $ztrap="zgoto "_$zlevel_":loope^%mgsqlw" 35 | s ok=$$read(.head,.cgi,.data) 36 | s ok=$$nvp($g(cgi("QUERY_STRING")),.nvp) 37 | i $g(cgi("CONTENT_TYPE"))="application/x-www-form-urlencoded" s ok=$$nvp($g(data),.nvp) 38 | i '$d(nvp("UCI")) s nvp("UCI")="USER" 39 | i $g(nvp("UCI"))'="" s ok=$$cuci^%mgsqls($g(nvp("UCI"))) 40 | i $g(cgi("SCRIPT_NAME"))[".ico" d notfound g loop1 41 | i $d(nvp("SQL")) d sql(dbid,.%zi,$g(nvp("SQL"))) g loop1 42 | i $d(nvp("sql")) d sql(dbid,.%zi,$g(nvp("sql"))) g loop1 43 | i $d(nvp("QUERY")) d sql(dbid,.%zi,$g(nvp("QUERY"))) g loop1 44 | i $d(nvp("query")) d sql(dbid,.%zi,$g(nvp("query"))) g loop1 45 | i $g(cgi("CONTENT_TYPE"))["/sql" d sql(dbid,.%zi,data) g loop1 46 | d sqlform 47 | loop1 ; request satisfied 48 | c $I 49 | h 50 | loope ; error 51 | s error=$$error^%mgsqls(),error(5)="HY000" 52 | d servererror(error) 53 | d logerror^%mgsqls($$error^%mgsqls(),"M Exception") 54 | h 55 | ; 56 | init(%zi) ; essential constants 57 | n dbid 58 | s dbid="mgsql" 59 | s %zi("df")=$c(1) 60 | s %zi("base")=10 61 | q dbid 62 | ; 63 | read(head,cgi,data) ; read request 64 | n x,i,line,len,clen,pathinfo 65 | k cgi 66 | s data="" 67 | f r *x s head=head_$c(x) q:head[$c(13,10,13,10) 68 | s head=$$rreplace^%mgsqls(head," "," ") 69 | s line=$p(head,$c(13,10),1) 70 | s cgi("REQUEST_METHOD")=$p(line," ",1) 71 | s cgi("SCRIPT_NAME")=$p($p(line," ",2),"?",1) 72 | s cgi("PATH_INFO")=$p(cgi("SCRIPT_NAME"),".sql",2,9999) 73 | s cgi("SCRIPT_NAME")=$p(cgi("SCRIPT_NAME"),".sql",1)_".sql" 74 | i line["?" s cgi("QUERY_STRING")=$p($p(line," ",2),"?",2,9999) 75 | s cgi("SERVER_PROTOCOL")=$p(line," ",3) 76 | f i=2:1 s line=$p(head,$c(13,10),i) q:line="" d 77 | . s name=$tr($$ucase^%mgsqls($$rtrim^%mgsqls($p(line,":",1)," ")),"-","_") 78 | . i name="CONTENT_LENGTH"!(name="CONTENT_TYPE") s cgi(name)=$$ltrim^%mgsqls($p(line,":",2,999)," ") q 79 | . s cgi("HTTP_"_name)=$$ltrim^%mgsqls($p(line,":",2,999)," ") 80 | . q 81 | s clen=+$g(cgi("CONTENT_LENGTH")) i clen=0 q 1 82 | s data="",len=0 f r x#(clen-len) s data=data_x,len=len+$l(x) i len=clen q 83 | q 1 84 | reade ; Error 85 | q 0 86 | ; 87 | nvp(qs,nvp) ; get name/value pairs for url-encoded content 88 | n i,p,name,value 89 | i qs="" q 1 90 | f i=1:1:$l(qs,"&") s p=$p(qs,"&",i) d 91 | . s name=$p(p,"=",1),value=$p(p,"=",2) 92 | . i name="" q 93 | . s nvp($$urldecode^%mgsqls(name))=$$urldecode^%mgsqls(value) 94 | . q 95 | q 1 96 | nvpe ; Error 97 | q 0 98 | ; 99 | sql(dbid,%zi,sql) ; run query 100 | n %zo,cols,stmt,error,line,info,rou,qid,i,r,cname,tname,dtyp,ag,ok,rc 101 | s dbid=$$schema^%mgsql("") 102 | s stmt=0 103 | s sql=$tr(sql,$c(13,10),"") 104 | s error="" 105 | s line(1)=sql 106 | s %zi(0,"stmt")=0 107 | s rou=$$main^%mgsqlx(dbid,.line,.info,.error) 108 | i rou="" s error="Invalid Query",error(5)="HY000" 109 | i error'="" g sql1 110 | s qid=$g(info("qid")) 111 | f i=1:1 q:'$d(^mgsqlx(1,dbid,qid,"out",i)) d 112 | . s r=$g(^(i)) 113 | . s cname=$p(r,"~",1) 114 | . s tname=$p(r,"~",2) 115 | . s dtyp=$p(r,"~",8) 116 | . i cname["(" d q 117 | . . s ag=$p(cname,"("),cname=$p($p(cname,"(",2,999),")",1) 118 | . . i cname["." s cname=$p(cname,".",2) 119 | . . s ag=$$trim^%mgsqln(ag," ") 120 | . . s cname=$$trim^%mgsqln(cname," ") 121 | . . i cname="" s cname="col_"_i 122 | . . s cname=ag_"-"_cname 123 | . . s cname=$tr(cname,":","") 124 | . . q 125 | . i cname["." s cname=$p(cname,".",2) 126 | . i cname="" s cname="xxx" 127 | . s cols(i)=cname 128 | . q 129 | i $d(info("sp")) d g sql1 130 | . s ok=-1 131 | . s %zo("routine")=rou 132 | . s %zi(0,"stmt")=stmt 133 | . s rc=$$so^%mgsqlz() 134 | . s @("ok=$$"_rou_"(.%zi,.%zo)") 135 | . s rc=$$sc^%mgsqlz() 136 | . q 137 | i rou'="" s %zo("routine")=rou,@("ok=$$exec^"_rou_"(.%zi,.%zo)") 138 | sql1 ; output result 139 | d json(.%zi,.%zo,.cols,.error) 140 | q 141 | ; 142 | json(%zi,%zo,cols,error) ; output results as JSON document 143 | n %z,head,out,ecom,rn,cn,name,value,com 144 | d gvars^%mgsqlx(.%z) 145 | s head="HTTP/1.1 200 OK"_$c(13,10) 146 | ;s head=head_"Content-Type: text/plain"_$c(13,10) 147 | ;s head=head_"Content-Type: text/x-json"_$c(13,10) 148 | s head=head_"Content-Type: application/json"_$c(13,10) 149 | s head=head_"Connection: close"_$c(13,10) 150 | s head=head_$c(13,10) 151 | w head d flush^%mgsqls() 152 | i $g(error)'="" s out="{""sqlcode"": "_"-1"_", ""sqlstate"": """_$s($d(error(5)):error(5),1:"HY000")_""", ""error"": """_error_"""}" g json1 153 | s out="{""sqlcode"": "_"0"_", ""sqlstate"": """_"00000"_""", ""error"": "_"""""" 154 | s out=out_", ""result"": [",ecom="" 155 | f rn=1:1 q:'$d(^mgsqls($j,%zi(0,"stmt"),0,rn)) d 156 | . s out=out_ecom_"{",com="",ecom="," 157 | . f cn=1:1 q:'$d(^mgsqls($j,%zi(0,"stmt"),0,rn,cn)) d 158 | .. s name=$g(cols(cn)) 159 | .. i name[%z("dsv") s name=$p(name,%z("dsv"),2) 160 | .. s name=$tr(name,".","_") 161 | .. s value=$g(^mgsqls($j,%zi(0,"stmt"),0,rn,cn)) 162 | .. s out=out_com_""""_name_""""_": """_value_"""",com="," 163 | .. q 164 | . s out=out_"}" 165 | . q 166 | s out=out_"]" 167 | s out=out_"}" 168 | json1 ; response complete 169 | w out d flush^%mgsqls() 170 | q 171 | ; 172 | sqlform ; output a simple form 173 | n head,out 174 | s head="HTTP/1.1 200 OK"_$c(13,10) 175 | s head=head_"Content-Type: text/html"_$c(13,10) 176 | s head=head_"Connection: close"_$c(13,10) 177 | s head=head_$c(13,10) 178 | w head d flush^%mgsqls() 179 | s out=""_$c(13,10) 180 | s out=out_"SQL Test Form"_$c(13,10) 181 | s out=out_""_$c(13,10) 182 | s out=out_"
"_$c(13,10) 183 | s out=out_"

SQL Test Form

"_$c(13,10) 184 | s out=out_"

"_$c(13,10) 185 | s out=out_""_$c(13,10) 186 | s out=out_"

"_$c(13,10) 187 | s out=out_""_$c(13,10) 188 | s out=out_"
"_$c(13,10) 189 | s out=out_""_$c(13,10) 190 | s out=out_""_$c(13,10) 191 | w out d flush^%mgsqls() 192 | q 193 | ; 194 | notfound ; HTTP not found 195 | n head 196 | s head="HTTP/1.1 404 Not Found"_$c(13,10) 197 | s head=head_"Connection: close"_$c(13,10) 198 | s head=head_$c(13,10) 199 | w head d flush^%mgsqls() 200 | q 201 | ; 202 | servererror(error) ; HTTP internal server error 203 | n head 204 | s head="HTTP/1.1 500 Internal Server Error"_$c(13,10) 205 | s head=head_"Connection: close"_$c(13,10) 206 | s head=head_$c(13,10) 207 | w head,error 208 | d flush^%mgsqls() 209 | q 210 | ; 211 | test ; test harness 212 | k 213 | ;s sql="select * from patient a" 214 | s sql="call patient_getdata" 215 | d sql(sql) 216 | q 217 | ; 218 | -------------------------------------------------------------------------------- /yottadb/_mgsqlx.m: -------------------------------------------------------------------------------- 1 | %mgsqlx ;(CM) sql - MGSQL as a server ; 28 Jan 2022 10:04 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlx") q 26 | ; 27 | main(dbid,line,info,error) ; compile query 28 | n (%z,dbid,line,info,error) 29 | new $ztrap set $ztrap="zgoto "_$zlevel_":maine^%mgsqlx" 30 | s rou="",error="" 31 | d gvars(.%z) 32 | s ddl=$$verify(dbid,.line,.sql,.error) i ddl=1 g exit 33 | m info("tp")=sql("txp") 34 | i $d(info("tp")),'$d(sql(0,1)) g exit 35 | s qid=$$hash(dbid,.rou,.line) 36 | d gcvars(dbid,qid,.%zq) 37 | s info("qid")=qid 38 | i ddl=2 s info("sp")=rou g main1 39 | ; Force recompilation if instructed to 40 | i $g(info(0,"recompile"))=1 k ^mgsqlx(1,dbid,qid,"m") 41 | ; Don't recompile if already compiled 42 | i $d(^mgsqlx(1,dbid,qid,"m")) g exit 43 | d comp(dbid,qid,rou,.sql,.line,.error) 44 | main1 d save 45 | g exit 46 | maine ; error 47 | s error="System Exception: "_$$error^%mgsqls(),error(5)="HY000" 48 | exit ; exit 49 | q rou 50 | ; 51 | n36(n10) ; generate 3 character base-36 node number 000 -> zzz 52 | n alpha,char,n36,rem 53 | s alpha="0123456789abcdefghijklmnopqrstuvwxyz" 54 | s n36="" f char=1:1:3 s rem=n10#36,n10=n10\36,n36=$e(alpha,rem+1)_n36 55 | q n36 56 | ; 57 | hash(dbid,sqrou,line) ; apply hashing algorithm to query 58 | n lin,ln,chng,n10,n36,i,mxi,hash 59 | s sqrou="" 60 | s ln=0 f i=1:1 q:'$d(line(i)) s lin=line(i),ln=ln+1,lin(ln)=lin 61 | s mxi=i-1 62 | s hash="" f i=1:1:3 s n10=$s($d(lin(i)):$l(lin(i)),1:0) s n36=$$n36(n10) s hash=hash_$e(n36,2,3) 63 | s n10=mxi,n36=$$n36(n10),hash=hash_$e(n36,2,3) 64 | ; try and find existing query 65 | s chng=1,qid="" f s qid=$o(^mgsqlx(2,dbid,hash,qid)) q:qid="" i '$$hash1(dbid,qid,.line) q 66 | i '$l(qid) s qid=$$prfx() 67 | s sqrou="x"_qid_1 i $d(^mgtmp($j,"sp")) s sqrou=$g(^mgtmp($j,"sp")),^mgsqlx(1,dbid,qid,"sp")=sqrou 68 | s ^mgsqlx(1,dbid,qid,"hash")=hash,^("rou")=sqrou,^mgsqlx(2,dbid,hash,qid)="" 69 | f i=1:1 q:'$d(line(i)) s ^mgsqlx(1,dbid,qid,"sql",i)=line(i) 70 | q qid 71 | ; 72 | hash1(dbid,qid,line) ; compare individual query 73 | n chng,i 74 | s chng=0 75 | f i=1:1 q:'$d(^mgsqlx(1,dbid,qid,"sql",i)) s:'$d(line(i)) chng=1 q:chng i ^(i)'=line(i) s chng=1 q 76 | i $d(line(i)) s chng=1 77 | q chng 78 | ; 79 | save ; allocate query id and save query 80 | n type,i,l,to,fr,rou 81 | m ^mgsqlx(1,dbid,qid,"in")=^mgtmp($j,"in") 82 | m ^mgsqlx(1,dbid,qid,"t")=^mgtmp($j,"sqlupd") 83 | f i=1:1 q:'$d(^mgtmp($j,"outsel",1,i)) s var=$g(^(i)) d 84 | . s tname="",cname=var 85 | . i var[%z("dsv") s var=$p(var,%z("dsv"),2) 86 | . s alias=$p(var,".",1),cname=$p(var,".",2) 87 | . i alias'="" s tno=$g(^mgtmp($j,"from","x",1,alias)) i tno'="" s tname=$p($g(^mgtmp($j,"from",1,tno)),"~",1) 88 | . s ^mgsqlx(1,dbid,qid,"out",i)=var_"~"_tname_"~"_cname_"~"_$$dtype^%mgsqld(dbid,tname,cname) 89 | . q 90 | i '$d(^mgsqlx(1,dbid,qid,"sp")) s code="^mgsqlx(1,dbid,qid,""m"",i)",mxi=$g(^mgsqlx(1,dbid,qid,"m")),rou="x"_qid_"1",ok=$$zs^%mgsqlr(rou,code,mxi) 91 | q 92 | ; 93 | del(dbid,qid) ; delete script from file 94 | n hash,rou,ok 95 | s (hash,rou)="" 96 | i $d(^mgsqlx(1,dbid,qid,"hash"))#10 s hash=^("hash") 97 | i $d(^mgsqlx(1,dbid,qid,"rou"))#10 s rou=^("rou") 98 | i $l(rou) s ok=$$zr^%mgsqlr(rou) 99 | i $l(hash) k ^mgsqlx(1,dbid,hash,qid) 100 | d delcalls(dbid,qid) 101 | d delupd(dbid,qid) 102 | k ^mgsqlx(1,dbid,qid) 103 | q 104 | ; 105 | delcalls(dbid,qid) ; delete calls index 106 | k ^mgsqlx(1,dbid,qid,"calls") 107 | q 108 | ; 109 | delupd(dbid,qid) ; delete update index 110 | k ^mgsqlx(1,dbid,qid,"squpd") 111 | q 112 | ; 113 | newfid ; file updated - wipe out affected code 114 | n (%z,dbid,tname) 115 | q 116 | newfide ; error 117 | q 118 | ; 119 | prfx() ; assign new prefix 120 | n n10,qid 121 | l ^mgsqlx(0) 122 | i '$d(^mgsqlx(0)) s ^(0)=0 123 | s n10=^(0)+1,^(0)=n10 124 | l 125 | s qid=$$n36(n10) 126 | q qid 127 | ; 128 | verify(dbid,line,sql,error) ; verify query and execute any DDL commands 129 | n ddl 130 | s ddl=0 131 | d main^%mgsqlv(dbid,.line,.sql,.error) 132 | i $e(error,1,5)="\ddl\" s ddl=1,error=$e(error,6,999) 133 | i $e(error,1,4)="\sp\" s ddl=2,error=$e(error,5,999) 134 | q ddl 135 | ; 136 | comp(dbid,qid,rou,sql,line,error) ; compile query 137 | n i,ok,var 138 | k ^mgsqlx(1,dbid,qid,"var") 139 | d delcalls(dbid,qid) 140 | d delupd(dbid,qid) 141 | d main^%mgsqlo(dbid,qid,.sql,.error) i $l(error) g compx 142 | d main^%mgsqlc i $l(error) g compx 143 | compx ; exit compilation process 144 | i $l(error) s ^mgsqlx(1,dbid,qid,"error")=error d del(dbid,qid) 145 | q 146 | ; 147 | upd() ; see if updates are allowed 148 | s upd=0 149 | q upd 150 | ; 151 | acc(user,model,entity,context,error,info) ; see if access is allowed 152 | s error="" 153 | q 1 154 | i user="s3992\muntc" q 1 155 | i 'result,error="" s error="you ("_user_") may not access "_entity_" (app="_$g(info("app"))_"; ip="_$g(info("ip"))_")",error(5)="42000" 156 | q result 157 | ; 158 | gvars(vars) ; initialize global variables 159 | k vars 160 | s vars("pv")="sq" 161 | s vars("pt")="sq" 162 | s vars("dsv")="{s}" 163 | s vars("dev")="{v}" 164 | s vars("df")="{f}" 165 | s vars("de")="{e}" 166 | s vars("dq")="{q}" 167 | s vars("dl")="{l}" 168 | s vars("ds")="{$}" 169 | s vars("dc")="{z}" 170 | s vars("db")="{b}" 171 | s vars("vok")=vars("dsv")_"__status"_vars("dsv") 172 | s vars("vdata")=vars("dsv")_"__data"_vars("dsv") 173 | s vars("vdatax")=vars("dsv")_"__datax"_vars("dsv") 174 | s vars("vrc")=vars("dsv")_"__rowcount"_vars("dsv") 175 | s vars("vn")=vars("dsv")_"__count"_vars("dsv") 176 | s vars("vnx")=vars("dsv")_"__count_d"_vars("dsv") 177 | s vars("vdef")=vars("dsv")_"__defined"_vars("dsv") 178 | s vars("vck")=vars("dsv")_"__compound_key"_vars("dsv") 179 | s vars("vckcrc")=vars("dsv")_"__compound_key_crc"_vars("dsv") 180 | s vars("vckcrcdef")=vars("dsv")_"__compound_key_crc_defined"_vars("dsv") 181 | s vars("ctg")="^mgtemp" 182 | s vars("cts")="$j" 183 | q 184 | ; 185 | gcvars(dbid,qid,vars) ; initialize global variables 186 | s vars("ccode")="^mgsqlx(1,"""_dbid_""","""_qid_""",""m""" 187 | s vars("ccoder")="^mgsqlx(1,"""_dbid_""","""_qid_""",""mr""" 188 | q 189 | ; 190 | -------------------------------------------------------------------------------- /yottadb/_mgsqlz.m: -------------------------------------------------------------------------------- 1 | %mgsqlz ;(CM) MGSQL : client-server computing ; 28 Jan 2022 10:04 AM 2 | ; 3 | ; ---------------------------------------------------------------------------- 4 | ; | MGSQL | 5 | ; | Author: Chris Munt cmunt@mgateway.com, chris.e.munt@gmail.com | 6 | ; | Copyright (c) 2016-2023 MGateway Ltd | 7 | ; | Surrey UK. | 8 | ; | All rights reserved. | 9 | ; | | 10 | ; | http://www.mgateway.com | 11 | ; | | 12 | ; | Licensed under the Apache License, Version 2.0 (the "License"); you may | 13 | ; | not use this file except in compliance with the License. | 14 | ; | You may obtain a copy of the License at | 15 | ; | | 16 | ; | http://www.apache.org/licenses/LICENSE-2.0 | 17 | ; | | 18 | ; | Unless required by applicable law or agreed to in writing, software | 19 | ; | distributed under the License is distributed on an "AS IS" BASIS, | 20 | ; | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | 21 | ; | See the License for the specific language governing permissions and | 22 | ; | limitations under the License. | 23 | ; ---------------------------------------------------------------------------- 24 | ; 25 | a d vers^%mgsql("%mgsqlz") q 26 | ; 27 | so(%zi,%zo) ; server: open 28 | i $g(%zi(0,"stmt"))'="" k ^mgsqls($j,%zi(0,"stmt")) 29 | q 0 30 | ; 31 | ss(%zi,%zo,rn) ; server: row of data 32 | n i,stop 33 | i $g(%zi(0,"stmt"))'="" d k %zo(rn) q 0 34 | . f i=1:1 q:'$d(%zo(rn,i)) i $g(%zo(0,i,0))="date" s %zo(rn,i)=$$ddate^%mgsqls($g(%zo(rn,i)),1) 35 | . m ^mgsqls($j,%zi(0,"stmt"),0,rn)=%zo(rn) 36 | . q 37 | i $g(%zi(0,"callback"))'="" d k %zo(rn) q stop 38 | . f i=1:1 q:'$d(%zo(rn,i)) i $g(%zo(0,i,0))="date" s %zo(rn,i)=$$ddate^%mgsqls($g(%zo(rn,i)),1) 39 | . s @("stop=$$"_$g(%zi(0,"callback"))_"(.%zi,.%zo,rn)") 40 | . q 41 | w ! f i=1:1 q:'$d(%zo(rn,i)) d 42 | . i i>1 w "," 43 | . i $g(%zo(0,i,0))="date" w $$ddate^%mgsqls($g(%zo(rn,i)),1) q 44 | . i $g(%zo(rn,i))["," w """"_$g(%zo(rn,i))_"""" q 45 | . w $g(%zo(rn,i)) 46 | . q 47 | k %zo(rn) 48 | q 0 49 | ; 50 | sc(%zi,%zo) ; server: close 51 | i $g(%zi(0,"stmt"))'="" k ^mgsqls($j,%zi(0,"stmt"),1),^mgsqls($j,%zi(0,"stmt"),2),^mgsqls($j,%zi(0,"stmt"),3) 52 | q 0 53 | ; 54 | tpcb(dbid,sql,%zi,%zo,info) ; transaction processing callback 55 | n ok,cb 56 | s ok=0 57 | s cb=$g(%zi(0,"callback")) k %zi(0,"callback") 58 | i $d(info("tp",0,"start")),cb="",$$isydb^%mgsqls() s %zo("error")="A callback must be defined for transactions in YottaDB" q -1 59 | i $d(info("tp",0,"start")) k info("tp",0,"start") tstart 60 | i $g(%zo("routine"))'="" s @("ok=$$exec^"_%zo("routine")_"(.%zi,.%zo)") 61 | i $d(info("tp",0,"commit")) k info("tp",0,"commit") i $tlevel>0 tcommit 62 | i $d(info("tp",0,"rollback")) k info("tp",0,"rollback") i $tlevel>0 trollback 63 | i cb'="" s @("ok=$$"_cb_"(.%zi,.%zo)") 64 | q ok 65 | ; 66 | --------------------------------------------------------------------------------