The code files. Taken from assembla working copy
This commit is contained in:
parent
9403a67ac7
commit
aeeab31ecf
765
enode-lisp/enode-oracle.el
Executable file
765
enode-lisp/enode-oracle.el
Executable file
|
|
@ -0,0 +1,765 @@
|
|||
|
||||
(defun enode-oracle-connect (conn-user conn-pass conn-connection conn-prompt)
|
||||
"A function to connect to an oracle database."
|
||||
;; Create a temporary buffer and go to it.
|
||||
(with-temp-buffer
|
||||
;; Set it to be an SQL commands buffer.
|
||||
(sql-mode)
|
||||
;; Put in the connection and sqlprompt modification commands, and
|
||||
;; set the serverout on.
|
||||
(insert
|
||||
(format "\nconnect %s/%s@%s\nset serverout on\nset sqlprompt \"%s> \"\n"
|
||||
conn-user
|
||||
conn-pass
|
||||
conn-connection
|
||||
conn-prompt))
|
||||
;; Send the temp buffer to the *SQL* process buffer.
|
||||
(sql-send-region (point-min) (point-max))
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-disconnect ()
|
||||
"A function to close an oracle database connection."
|
||||
(with-temp-buffer
|
||||
(sql-mode)
|
||||
(insert (format "\ndisconnect\n"))
|
||||
(sql-send-region (point-min) (point-max))
|
||||
(enode-oracle-sqlplus-set-prompt "NOP")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-start-sql-engine ()
|
||||
"A function to set up the SQL engine for connecting to an Oracle database.
|
||||
Currently, only SQL*Plus is supported."
|
||||
(call-interactively 'sql-oracle)
|
||||
;; Set the prompt regexps properly
|
||||
(save-excursion
|
||||
(set-buffer "*SQL*")
|
||||
(setq comint-prompt-regexp "^[0-9A-Za-z]\\{3\\}> ")
|
||||
(setq sql-prompt-regexp "^[0-9A-Za-z]\\{3\\}> ")
|
||||
;; (enode-oracle-sqlplus-set-timing "on")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-stop-sql-engine ()
|
||||
"A function to close the engine connecting to the oracle database.
|
||||
Currently, only SQL*Plus is supported."
|
||||
;; Kludge to get around the fact that redirecting output from exit
|
||||
;; doesn't really work.
|
||||
(comint-send-string (get-buffer-process sql-buffer) (format "exit\n"))
|
||||
(sleep-for 3)
|
||||
;; (with-temp-buffer
|
||||
;; (enode-oracle-run-sql-command "exit"
|
||||
;; (current-buffer)
|
||||
;; sql-buffer
|
||||
;; t)
|
||||
;; )
|
||||
)
|
||||
|
||||
(defun enode-oracle-list-users (user-list-buffer)
|
||||
"A function to list the users in an Oracle database."
|
||||
(let ((user-list-command
|
||||
(format "select username from all_users order by username;"))
|
||||
)
|
||||
;; Run the SQL command.
|
||||
(enode-oracle-run-sql-command user-list-command
|
||||
user-list-buffer
|
||||
sql-buffer)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-desc (object-name desc-buffer)
|
||||
"A function to run the SQL DESCRIBE command for an object and to present
|
||||
the output."
|
||||
(let ((desc-command (format "desc %s" object-name)))
|
||||
(enode-oracle-run-sql-command desc-command
|
||||
desc-buffer
|
||||
sql-buffer)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-list-objects (object-list-buffer dbuser
|
||||
&optional object-type
|
||||
invalid-flag
|
||||
filter-string)
|
||||
"A function to get up a list of objects in an oracle database."
|
||||
(let ((object-list-command
|
||||
(format "%s%s%s;"
|
||||
"select object_name, object_type, status "
|
||||
(format "from %s " (if dbuser "all_objects" "user_objects"))
|
||||
(let (have-where
|
||||
where-clause)
|
||||
(if dbuser
|
||||
(if have-where
|
||||
(setq where-clause
|
||||
(concat where-clause
|
||||
" "
|
||||
(format "and owner = '%s' " dbuser)
|
||||
)
|
||||
)
|
||||
(setq where-clause
|
||||
(format "where owner = '%s' " dbuser))
|
||||
(setq have-where t)
|
||||
)
|
||||
)
|
||||
(if object-type
|
||||
(if have-where
|
||||
(setq where-clause
|
||||
(concat where-clause
|
||||
" "
|
||||
(format "and object_type = '%s' "
|
||||
object-type)
|
||||
)
|
||||
)
|
||||
(setq where-clause
|
||||
(format "where object_type = '%s' "
|
||||
object-type))
|
||||
(setq have-where t)
|
||||
)
|
||||
)
|
||||
(if invalid-flag
|
||||
(if have-where
|
||||
(setq where-clause
|
||||
(concat where-clause
|
||||
" and status = 'INVALID' "
|
||||
)
|
||||
)
|
||||
(setq where-clause
|
||||
"where status = 'INVALID' ")
|
||||
(setq have-where t)
|
||||
)
|
||||
)
|
||||
(if filter-string
|
||||
(if have-where
|
||||
(setq where-clause
|
||||
(concat where-clause
|
||||
" and object_name like '%"
|
||||
filter-string
|
||||
"%' "
|
||||
)
|
||||
)
|
||||
(setq where-clause
|
||||
(concat "where object_name like '%"
|
||||
filter-string
|
||||
"%' ")
|
||||
)
|
||||
(setq have-where t)
|
||||
)
|
||||
)
|
||||
where-clause
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(enode-oracle-run-sql-command object-list-command
|
||||
object-list-buffer
|
||||
sql-buffer)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-list-object-types (object-type-list-buffer
|
||||
&optional dbuser)
|
||||
"A function to show the list of object types in an oracle database broken
|
||||
down by user. If DBUSER is non-nil, list only for that user."
|
||||
(let ((object-type-list-command
|
||||
(format "%s%s%s%s%s;"
|
||||
"select owner, object_type, count(*) "
|
||||
"from all_objects "
|
||||
(if dbuser (format "where owner = '%s' " (upcase dbuser)) "")
|
||||
"group by owner, object_type "
|
||||
"order by owner, object_type "
|
||||
))
|
||||
)
|
||||
;; Run the SQL command.
|
||||
(enode-oracle-run-sql-command object-type-list-command
|
||||
object-type-list-buffer
|
||||
sql-buffer)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-run-sql-command (sql-command output-buffer sql-buffer
|
||||
&optional asynchronous)
|
||||
"A function to run an SQL command in a synchronous manner. If ASYNCHRONOUS is non-nil, it's run, you guessed it, asynchronously."
|
||||
;; Run it as though it's from where we're calling it.
|
||||
(save-excursion
|
||||
;; Run the command, not echoing the output.
|
||||
(comint-redirect-send-command-to-process sql-command
|
||||
output-buffer
|
||||
sql-buffer
|
||||
nil)
|
||||
;; If we don't want to pretend it's synchronous, don't
|
||||
(if (not asynchronous)
|
||||
(enode-wait-for-command)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-pls-code-max-length (pls-name pls-type &optional pls-owner)
|
||||
"A function to return the length of the longest line in a block of
|
||||
stored PL/SQL code."
|
||||
;; Do all this in a temporary buffer
|
||||
(with-temp-buffer
|
||||
;; Get the buffer name
|
||||
(let ((my-buffer (current-buffer))
|
||||
;; Determine the code to run
|
||||
(plsql-code-line-length-command
|
||||
(format "%s%s%s%s%s;"
|
||||
"select max ( length ( text ) ) "
|
||||
(format "from %s " (if pls-owner "all_source"
|
||||
"user_source"))
|
||||
(format "where name = '%s' " (upcase pls-name))
|
||||
(format "and type = '%s' " (upcase pls-type))
|
||||
(if pls-owner (format "and owner = '%s' "
|
||||
(upcase pls-owner))
|
||||
""))))
|
||||
;; Run the command synchronously
|
||||
(enode-oracle-run-sql-command plsql-code-line-length-command
|
||||
my-buffer
|
||||
sql-buffer)
|
||||
;; Go to the buffer
|
||||
(set-buffer my-buffer)
|
||||
;; Go to the end
|
||||
(goto-char (point-max))
|
||||
;; Look back for the returned value
|
||||
(re-search-backward "^[ ]+\\([0-9]+\\)[ ]*$")
|
||||
;; and return it.
|
||||
(match-string 1)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-pls-code (pls-name pls-type &optional pls-owner)
|
||||
"A function to present a block of PL/SQL code. Really should be called from
|
||||
a wrapper. PLS-NAME is the name of the PL/SQL block, PLS-TYPE is its type
|
||||
function, package, etc. and PLS-OWNER is the block's owner. If
|
||||
PLS-OWNER is NIL, assume the current user."
|
||||
;; Get the length of the longest line of the code block
|
||||
(let ((block-line-length
|
||||
(enode-oracle-pls-code-max-length pls-name pls-type pls-owner))
|
||||
;; Determine the current SQL*Plus state
|
||||
(current-sqlplus-state (enode-oracle-sqlplus-get-state))
|
||||
;; Get a buffer for the code.
|
||||
(code-buffer (enode-oracle-plsql-code-buffer pls-name pls-owner))
|
||||
)
|
||||
;; Set the SQL*Plus state to something that's suitable for this
|
||||
;; '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL
|
||||
;; LONGCHUNKSIZE TERMOUT)
|
||||
(enode-oracle-sqlplus-set-state (list block-line-length 0 nil "off"
|
||||
"off" nil)
|
||||
)
|
||||
;; Create the SQL code to get the PL/SQL code.
|
||||
(let ((plsql-code-command
|
||||
(format "%s%s%s%s%s%s;"
|
||||
"select text "
|
||||
(format "from %s " (if pls-owner "all_source"
|
||||
"user_source"))
|
||||
(format "where name = '%s' " (upcase pls-name))
|
||||
(format "and type = '%s' " (upcase pls-type))
|
||||
(if pls-owner (format "and owner = '%s' "
|
||||
(upcase pls-owner))
|
||||
"")
|
||||
"order by line")))
|
||||
;; Run the command.
|
||||
(enode-oracle-run-sql-command plsql-code-command code-buffer sql-buffer)
|
||||
)
|
||||
;; Restore the state
|
||||
(enode-oracle-sqlplus-set-state current-sqlplus-state)
|
||||
(save-excursion
|
||||
;; Go to the buffer with the code.
|
||||
(set-buffer code-buffer)
|
||||
;; It's PL/SQL code, set the mode.
|
||||
(pls-mode)
|
||||
)
|
||||
(display-buffer code-buffer)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-timing-on ()
|
||||
"Turn on timing reports for SQL*Plus commands"
|
||||
(interactive)
|
||||
(enode-oracle-sqlplus-set-timing "on")
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-pls-package-code (proc-name &optional proc-owner)
|
||||
"A function to return the code of a PL/SQL package spec."
|
||||
(interactive (list (read-from-minibuffer "Package Name: ")))
|
||||
(enode-oracle-get-pls-code proc-name "package" proc-owner))
|
||||
|
||||
(defun enode-oracle-get-pls-package-body-code (proc-name &optional proc-owner)
|
||||
"A function to return the code of a PL/SQL package body."
|
||||
(interactive (list (read-from-minibuffer "Package Name: ")))
|
||||
(enode-oracle-get-pls-code proc-name "package body" proc-owner))
|
||||
|
||||
(defun enode-oracle-get-pls-procedure-code (proc-name &optional proc-owner)
|
||||
"A function to return the code of a PL/SQL procedure."
|
||||
(interactive (list (read-from-minibuffer "Procedure Name: ")))
|
||||
(enode-oracle-get-pls-code proc-name "procedure" proc-owner))
|
||||
|
||||
(defun enode-oracle-get-pls-function-code (func-name &optional func-owner)
|
||||
"A function to return the code of a PL/SQL function."
|
||||
(interactive (list (read-from-minibuffer "Function Name: ")))
|
||||
(enode-oracle-get-pls-code func-name "function" func-owner))
|
||||
|
||||
(defun enode-oracle-sqlplus-get-state ()
|
||||
"A function to determine the current state of the SQL*Plus interface. It
|
||||
returns a list in the following format '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL LONGCHUNKSIZE TERMOUT)."
|
||||
;; Get the settings.
|
||||
(let ((current-linesize (enode-oracle-sqlplus-get-linesize))
|
||||
(current-pagesize (enode-oracle-sqlplus-get-pagesize))
|
||||
(current-timing (enode-oracle-sqlplus-get-timing))
|
||||
(current-heading (enode-oracle-sqlplus-get-heading))
|
||||
(current-feedback (enode-oracle-sqlplus-get-feedback))
|
||||
(current-long (enode-oracle-sqlplus-get-long))
|
||||
(current-trimout (enode-oracle-sqlplus-get-trimout))
|
||||
(current-trimspool (enode-oracle-sqlplus-get-trimspool))
|
||||
(current-longchunksize (enode-oracle-sqlplus-get-longchunksize))
|
||||
(current-termout (enode-oracle-sqlplus-get-termout))
|
||||
)
|
||||
;; Return the settings as a list.
|
||||
(list current-linesize current-pagesize current-timing current-heading
|
||||
current-feedback current-long current-trimout current-trimspool
|
||||
current-longchunksize current-termout)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-state (sqlplus-state)
|
||||
"A function to put the current SQL*Plus interface into a certain statd. It
|
||||
takes a list in the following format '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL LONGCHUNKSIZE TERMOUT).
|
||||
If any of this is NIL, it's not touched"
|
||||
;; Determine the settings
|
||||
(let ((new-linesize (nth 0 sqlplus-state))
|
||||
(new-pagesize (nth 1 sqlplus-state))
|
||||
(new-timing (nth 2 sqlplus-state))
|
||||
(new-heading (nth 3 sqlplus-state))
|
||||
(new-feedback (nth 4 sqlplus-state))
|
||||
(new-long (nth 5 sqlplus-state))
|
||||
(new-trimout (nth 6 sqlplus-state))
|
||||
(new-trimspool (nth 7 sqlplus-state))
|
||||
(new-longchunksize (nth 8 sqlplus-state))
|
||||
(new-termout (nth 9 sqlplus-state))
|
||||
)
|
||||
;; For each of the settings that are specified in the parameter,
|
||||
;; set it.
|
||||
(if new-linesize (enode-oracle-sqlplus-set-linesize new-linesize))
|
||||
(if new-pagesize (enode-oracle-sqlplus-set-pagesize new-pagesize))
|
||||
(if new-timing (enode-oracle-sqlplus-set-timing new-timing))
|
||||
(if new-heading (enode-oracle-sqlplus-set-heading new-heading))
|
||||
(if new-feedback (enode-oracle-sqlplus-set-feedback new-feedback))
|
||||
(if new-long (enode-oracle-sqlplus-set-long new-long))
|
||||
(if new-trimout (enode-oracle-sqlplus-set-trimout new-trimout))
|
||||
(if new-trimspool (enode-oracle-sqlplus-set-trimspool new-trimspool))
|
||||
(if new-longchunksize
|
||||
(enode-oracle-sqlplus-set-longchunksize new-longchunksize))
|
||||
(if new-termout (enode-oracle-sqlplus-set-termout new-termout))
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-plsql-code-buffer
|
||||
(&optional pls-block-name pls-block-owner)
|
||||
"A function to return a buffer to contain the code of a PL/SQL object. The
|
||||
name of the buffer encorporates the name of the block if not nil"
|
||||
(enode-code-buffer "plsql" pls-block-name pls-block-owner)
|
||||
)
|
||||
|
||||
(defun enode-oracle-view-code-buffer
|
||||
(&optional view-name view-owner)
|
||||
"A function to return a buffer to contain the code of a view. The
|
||||
name of the buffer encorporates the name of the block if not nil"
|
||||
(enode-code-buffer "view" view-name view-owner)
|
||||
)
|
||||
|
||||
(defun enode-oracle-view-length (view-name &optional view-owner)
|
||||
"A function to return the length of the code making up the definition of
|
||||
a view."
|
||||
;; Do all this in a temporary buffer
|
||||
(with-temp-buffer
|
||||
;; What buffer?
|
||||
(let ((my-buffer (current-buffer))
|
||||
;; Create the SQL command to determine the value
|
||||
(view-code-length-command
|
||||
(format "%s%s%s%s;"
|
||||
"select text_length "
|
||||
(format "from %s " (if view-owner "all_views"
|
||||
"user_views"))
|
||||
(format "where view_name = '%s' " (upcase view-name))
|
||||
(if view-owner (format "and owner = '%s' "
|
||||
(upcase view-owner))
|
||||
""))))
|
||||
;; Run the command.
|
||||
(enode-oracle-run-sql-command view-code-length-command
|
||||
my-buffer
|
||||
sql-buffer)
|
||||
;; Go to the output buffer
|
||||
(set-buffer my-buffer)
|
||||
;; Go to the end.
|
||||
(goto-char (point-max))
|
||||
;; Look for the output
|
||||
(re-search-backward "^[ ]+\\([0-9]+\\)[ ]*$")
|
||||
;; Return it
|
||||
(match-string 1)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-view-code (view-name &optional view-owner)
|
||||
"A function to present the code that makes up a view."
|
||||
(interactive (list (read-from-minibuffer "View name: ")))
|
||||
;; Get the current SQL*Plus state
|
||||
(let ((current-sqlplus-state (enode-oracle-sqlplus-get-state))
|
||||
;; The buffer to send the code to
|
||||
(code-buffer (enode-oracle-view-code-buffer view-name view-owner))
|
||||
)
|
||||
;; Set the SQL*Plus state to something that is suitable.
|
||||
;; '(LINESIZE PAGESIZE TIMING HEADING FEEDBACK LONG TRIMOUT TRIMSPOOL
|
||||
;; LONGCHUNKSIZE TERMOUT)
|
||||
(enode-oracle-sqlplus-set-state (list 2499 0 "off" "off" "off" 5242880 "on"
|
||||
"on" 2499 "off"))
|
||||
;; Create the command to get the code.
|
||||
(let ((view-command
|
||||
;; select dbms_metadate.get_ddl ( 'VIEW', '<<VIEW_NAME>>' )
|
||||
;; from dual
|
||||
(format "%s%s%s;"
|
||||
"select dbms_metadata.get_ddl ( 'VIEW', '"
|
||||
(upcase view-name)
|
||||
"' ) from dual"
|
||||
)))
|
||||
;; Run the command.
|
||||
(enode-oracle-run-sql-command view-command code-buffer sql-buffer)
|
||||
)
|
||||
;; Restore the SQL*Plus state.
|
||||
(enode-oracle-sqlplus-set-state current-sqlplus-state)
|
||||
(save-excursion
|
||||
;; Go to the buffer
|
||||
(set-buffer code-buffer)
|
||||
;; It's SQL code. Set the mode.
|
||||
(sql-mode)
|
||||
)
|
||||
(display-buffer code-buffer)
|
||||
)
|
||||
)
|
||||
|
||||
;;;; Change this to use enode-oracle-run-sql-command
|
||||
(defun enode-oracle-sqlplus-get-param (sql-setting-command sql-setting-regexp)
|
||||
"A function to get an SQL*Plus setting. It simply runs SQL-SETTING-COMMAND
|
||||
and looks in the output for the first parenthesized expression in
|
||||
SQL-SETTING-REGEXP."
|
||||
;; We don't want to disturb anything, now do we?
|
||||
(save-excursion
|
||||
;; Get an empty output buffer
|
||||
(let ((output-buffer (enode-temp-output-buffer)))
|
||||
;; Send the command that was passed to get the setting.
|
||||
(comint-redirect-send-command-to-process
|
||||
sql-setting-command output-buffer sql-buffer nil t)
|
||||
;; Go to the output buffer
|
||||
(set-buffer output-buffer)
|
||||
;; Wait a short period for the command to complete
|
||||
(enode-wait-for-command)
|
||||
;; Go to the last position
|
||||
(goto-char (point-max))
|
||||
;; Search backwards for the passed regular expression
|
||||
(search-backward-regexp sql-setting-regexp nil t)
|
||||
;; Return the first parenthesised expression from a matched string.
|
||||
(match-string 1)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-sql-prompt ()
|
||||
"A function to get the setting of the SQL*Plus prompt"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show sqlprompt" "sqlprompt \"\\([^\"]*\\)\"$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-prompt (value)
|
||||
"A function to set the 'sqlprompt' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "sqlprompt" (concat "\"" value "> \""))
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-linesize ()
|
||||
"A function to get the 'linesize' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show linesize" "linesize \\([0-9]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-linesize (value)
|
||||
"A function to set the 'linesize' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "linesize" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-long ()
|
||||
"A function to get the 'long' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show long" "long \\([0-9]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-long (value)
|
||||
"A function to set the 'long' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "long" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-longchunksize ()
|
||||
"A function to get the 'longchunksize' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show longchunksize" "longchunksize \\([0-9]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-longchunksize (value)
|
||||
"A function to set the 'longchunksize' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "longchunksize" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-pagesize ()
|
||||
"A function to get the 'pagesize' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show pagesize" "^pagesize \\([0-9]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-pagesize (value)
|
||||
"A function to set the 'pagesize' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "pagesize" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-heading ()
|
||||
"A function to get the 'heading' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show heading" "^heading \\(O[NF]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-heading (value)
|
||||
"A function to set the 'heading' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "heading" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-timing ()
|
||||
"A function to get the 'timing' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show timing" "^timing \\(O[NF]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-timing (value)
|
||||
"A function to set the 'timing' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "timing" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-termout ()
|
||||
"A function to get the 'termout' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show termout" "^termout \\(O[NF]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-termout (value)
|
||||
"A function to set the 'termout' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "termout" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-trimout ()
|
||||
"A function to get the 'trimout' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show trimout" "^trimout \\(O[NF]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-trimout (value)
|
||||
"A function to set the 'trimout' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "trimout" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-trimspool ()
|
||||
"A function to get the 'trimspool' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show trimspool" "^trimspool \\(O[NF]+\\)$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-trimspool (value)
|
||||
"A function to set the 'trimspool' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "trimspool" value)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-get-feedback ()
|
||||
"A function to get the 'feedback' SQL*Plus setting"
|
||||
(format "%s"
|
||||
(enode-oracle-sqlplus-get-param
|
||||
"show feedback" "^FEEDBACK \\(O[NF]+\\).*$")
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-sqlplus-set-feedback (value)
|
||||
"A function to set the 'feedback' SQL*Plus parameter to VALUE."
|
||||
(enode-oracle-sqlplus-set-param "feedback" value)
|
||||
)
|
||||
|
||||
;; This is useful for main ENODE environment.
|
||||
;;;; Is this necessary if we user with-temp-buffer()?
|
||||
(defun enode-temp-output-buffer ()
|
||||
"A function to return the temporary output buffer for redirected SQL
|
||||
commands. If the buffer already exists, it empties it first.
|
||||
Call this function directly if you don't care about the output. Set a variable
|
||||
to this function's return value if you want to process it once the command
|
||||
has completed."
|
||||
;; Get the buffer
|
||||
(let ((the-buffer (get-buffer-create " *enode-comint-sql-output*")))
|
||||
;; Empty it.
|
||||
(enode-clean-buffer the-buffer)
|
||||
;; Return it
|
||||
the-buffer
|
||||
)
|
||||
)
|
||||
|
||||
;; This is useful for main ENODE environment.
|
||||
;;;; Is this necessary if we user with-temp-buffer()?
|
||||
(defun enode-stage-buffer ()
|
||||
"A function to provide a buffer for staging commands out of."
|
||||
(let ((the-buffer (get-buffer-create " *enode-stage-buffer*")))
|
||||
;; Empty it
|
||||
(enode-clean-buffer the-buffer)
|
||||
;; Return it
|
||||
the-buffer
|
||||
)
|
||||
)
|
||||
|
||||
;;;; Change this to use enode-oracle-run-sql-command
|
||||
(defun enode-oracle-sqlplus-set-param (param value)
|
||||
"A function to set an sqlplus parameter, PARAM, to VALUE."
|
||||
(comint-redirect-send-command-to-process
|
||||
(format "set %s %s\n" param value)
|
||||
(enode-temp-output-buffer)
|
||||
(get-buffer-process sql-buffer)
|
||||
nil
|
||||
t)
|
||||
(enode-wait-for-command)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-table-constraints (owner table)
|
||||
"A function to return a list of tables belonging to OWNER"
|
||||
(let ((the-command
|
||||
(format
|
||||
"select constraint_name from all_constraints where table_name = '%s' and owner = '%s';"
|
||||
table
|
||||
owner
|
||||
)
|
||||
)
|
||||
)
|
||||
(comint-redirect-results-list-from-process
|
||||
(get-buffer-process sql-buffer)
|
||||
the-command
|
||||
"^\\([A-Z0-9_]+\\)$"
|
||||
1)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-table-indexes (owner table)
|
||||
"A function to return a list of indexes on TABLE belonging to OWNER"
|
||||
(let ((the-command
|
||||
(format
|
||||
"select index_name from all_indexes where table_name = '%s' and owner = '%s';"
|
||||
table
|
||||
owner
|
||||
)
|
||||
)
|
||||
)
|
||||
(comint-redirect-results-list-from-process
|
||||
(get-buffer-process sql-buffer)
|
||||
the-command
|
||||
"^\\([A-Z0-9_]+\\)$"
|
||||
1)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-triggers (owner table)
|
||||
"A function to return a list of indexes on TABLE belonging to OWNER"
|
||||
(let ((the-command
|
||||
(format
|
||||
"select trigger_name from all_triggers where table_name = '%s' and owner = '%s';"
|
||||
table
|
||||
owner
|
||||
)
|
||||
)
|
||||
)
|
||||
(comint-redirect-results-list-from-process
|
||||
(get-buffer-process sql-buffer)
|
||||
the-command
|
||||
"^\\([A-Z0-9_]+\\)$"
|
||||
1)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-constraint-columns (owner constraint)
|
||||
"A function to return as a list the names of columns in a constraint
|
||||
ordered by the position"
|
||||
(let ((the-command
|
||||
(format
|
||||
"select table_name || '.' || column_name from all_cons_columns where constraint_name = '%s' and owner = '%s' order by position;"
|
||||
constraint
|
||||
owner
|
||||
)
|
||||
)
|
||||
)
|
||||
(comint-redirect-results-list-from-process
|
||||
(get-buffer-process sql-buffer)
|
||||
the-command
|
||||
"^\\([\.A-Z0-9_]+\\)$"
|
||||
1)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-get-java-source (owner java-source)
|
||||
"A function to return the source of a stored java program."
|
||||
(let ((the-command
|
||||
(format
|
||||
"select text from all_source where name = '%s' and owner = '%s' and type = 'JAVA SOURCE' order by line;"
|
||||
java-source
|
||||
owner
|
||||
)
|
||||
)
|
||||
)
|
||||
(comint-redirect-send-command-to-process
|
||||
the-command
|
||||
(get-buffer-create "*tester*")
|
||||
(get-buffer-process sql-buffer)
|
||||
nil)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-oracle-commit (&optional rollback)
|
||||
"A function to commit changes to an oracle database"
|
||||
(let ((output-buffer (enode-temp-output-buffer))
|
||||
response-msg
|
||||
)
|
||||
(comint-redirect-send-command-to-process
|
||||
(if rollback (format "rollback;\n") (format "commit;\n"))
|
||||
output-buffer
|
||||
(get-buffer-process sql-buffer)
|
||||
nil
|
||||
t)
|
||||
(enode-wait-for-command)
|
||||
(save-excursion
|
||||
(set-buffer output-buffer)
|
||||
(goto-char (point-min))
|
||||
(forward-line)
|
||||
(setq response-msg
|
||||
(buffer-substring (point) (save-excursion (end-of-line) (point))))
|
||||
)
|
||||
(message "%s" response-msg)
|
||||
)
|
||||
)
|
||||
|
||||
(provide 'enode-oracle)
|
||||
1132
enode-lisp/enode.el
Executable file
1132
enode-lisp/enode.el
Executable file
File diff suppressed because it is too large
Load diff
806
enode-lisp/pls-extras.el
Executable file
806
enode-lisp/pls-extras.el
Executable file
|
|
@ -0,0 +1,806 @@
|
|||
(require 'pls-mode)
|
||||
|
||||
(defvar enode-pls-identifier-regexp
|
||||
(format "%s%s"
|
||||
(substring pls-identifier-regexp 0 4)
|
||||
(substring pls-identifier-regexp 7))
|
||||
"Removing the capital letters as this has problems later")
|
||||
|
||||
(defvar enode-pls-name-regexp
|
||||
(format "%s%s"
|
||||
(substring pls-name-regexp 0 4)
|
||||
(substring pls-name-regexp 7))
|
||||
"Removing the capital letters as this has problems later")
|
||||
|
||||
(defvar enode-pls-white-space-regexp
|
||||
"\\s-+"
|
||||
"White space that can separate two tokens."
|
||||
)
|
||||
|
||||
(defvar enode-pls-white-space-newline-regexp
|
||||
(concat "\\(
|
||||
\\|\\s-\\)+")
|
||||
;; \(^J\|\s-\)+
|
||||
"White space that can separate two tokens, including new-lines."
|
||||
)
|
||||
|
||||
(defvar enode-pls-white-space-maybe-regexp
|
||||
(concat "\\(\\s-\\)*")
|
||||
"The possibility of white space"
|
||||
)
|
||||
|
||||
(defvar enode-pls-white-space-newline-maybe-regexp
|
||||
(replace-regexp-in-string
|
||||
"\+$" "*" enode-pls-white-space-newline-regexp)
|
||||
"The possibility of white space, including newlines"
|
||||
)
|
||||
|
||||
(defvar enode-declare-regexp
|
||||
(concat "^" enode-pls-white-space-maybe-regexp
|
||||
"declare" enode-pls-white-space-maybe-regexp )
|
||||
"The DECLARE of an anonymous block"
|
||||
)
|
||||
|
||||
(defvar enode-create-regexp
|
||||
(concat "^" enode-pls-white-space-maybe-regexp "create\\("
|
||||
enode-pls-white-space-regexp "or" enode-pls-white-space-regexp
|
||||
"replace\\)*" enode-pls-white-space-regexp)
|
||||
"The CREATE... of a named block"
|
||||
)
|
||||
|
||||
(defvar enode-block-type-regexp
|
||||
(concat "\\(function\\|procedure\\|package\\("
|
||||
enode-pls-white-space-regexp "body\\)\\{0,1\\}\\)"
|
||||
enode-pls-white-space-regexp)
|
||||
"The types of named blocks"
|
||||
)
|
||||
|
||||
(defvar enode-type-spec-regexp
|
||||
;; This could be a lot better spec'd
|
||||
(concat "\\(" enode-pls-name-regexp "%type\\|" enode-pls-identifier-regexp "\\)")
|
||||
"The type of an identifier"
|
||||
)
|
||||
|
||||
(defvar enode-param-inout-spec-regexp
|
||||
;; This could be a lot better spec'd
|
||||
(concat "\\(in\\|out\\|in" enode-pls-white-space-regexp "out\\)")
|
||||
"The type of an identifier"
|
||||
)
|
||||
|
||||
(defvar enode-param-spec-regexp
|
||||
(concat enode-pls-identifier-regexp
|
||||
enode-pls-white-space-regexp
|
||||
"\\(" enode-param-inout-spec-regexp
|
||||
enode-pls-white-space-maybe-regexp "\\)*"
|
||||
enode-pls-white-space-maybe-regexp
|
||||
enode-type-spec-regexp)
|
||||
"A parameter in a function/procedure/etc."
|
||||
)
|
||||
|
||||
(defvar enode-authid-spec-regexp
|
||||
(concat "authid" enode-pls-white-space-regexp
|
||||
"\\(current_user\\|definer\\)"
|
||||
enode-pls-white-space-newline-maybe-regexp)
|
||||
)
|
||||
|
||||
(defvar enode-decl-return-regexp
|
||||
(concat "return" enode-pls-white-space-regexp enode-type-spec-regexp
|
||||
enode-pls-white-space-newline-maybe-regexp)
|
||||
"The RETURN clause of a function"
|
||||
)
|
||||
|
||||
(defvar enode-is-as-regexp
|
||||
(concat enode-pls-white-space-newline-maybe-regexp
|
||||
"[ai]s"
|
||||
enode-pls-white-space-newline-maybe-regexp)
|
||||
"The IS/AS clause"
|
||||
)
|
||||
|
||||
(defvar enode-block-name-regexp
|
||||
(concat "\\(" enode-pls-name-regexp "\\)"
|
||||
enode-pls-white-space-newline-regexp)
|
||||
"The format of a name for a block"
|
||||
)
|
||||
|
||||
(defvar enode-block-params-decl-regexp
|
||||
(concat "(" enode-pls-white-space-newline-maybe-regexp "\\("
|
||||
enode-param-spec-regexp
|
||||
enode-pls-white-space-newline-maybe-regexp ",*"
|
||||
enode-pls-white-space-newline-maybe-regexp "\\)+"
|
||||
enode-pls-white-space-newline-maybe-regexp ")"
|
||||
enode-pls-white-space-newline-maybe-regexp)
|
||||
"The format of a set of parameters for a function or procedure"
|
||||
)
|
||||
|
||||
(defvar enode-block-start-regexp
|
||||
(concat "\\(" enode-declare-regexp "\\|" enode-create-regexp
|
||||
enode-block-type-regexp enode-block-name-regexp "\\("
|
||||
enode-block-params-decl-regexp "\\)*\\(" enode-decl-return-regexp
|
||||
"\\)*\\(" enode-authid-spec-regexp "\\)*" enode-is-as-regexp "\\)" )
|
||||
"The whole \"phrase\" that starts a block"
|
||||
)
|
||||
|
||||
(defvar enode-block-name-match-position 8)
|
||||
|
||||
(defun enode-block-bounds ()
|
||||
"Determine whether we're in a package spec or body. Returns a list of the
|
||||
format (TYPE BEG END) where TYPE is 0 for spec and 1 for body and BEG and END
|
||||
are the beginning and end points of whichever.
|
||||
Returns NIL if neither."
|
||||
;; Variables for the start of the current block, its name, its end and where
|
||||
;; the point currently is.
|
||||
(let (block-start
|
||||
block-name
|
||||
block-end
|
||||
(position (point)))
|
||||
;; Don't go anywhere now....
|
||||
(save-excursion
|
||||
;; Locate the beginning of the enclosing block
|
||||
(setq block-start
|
||||
(re-search-backward enode-block-start-regexp nil t))
|
||||
;; If one exists...
|
||||
(if block-start
|
||||
;; ... get the block's name and where it ends.
|
||||
(progn
|
||||
(setq block-name (match-string enode-block-name-match-position))
|
||||
(setq block-end
|
||||
(re-search-forward
|
||||
(format
|
||||
"^ *end %s *;"
|
||||
(if block-name block-name "*")
|
||||
)
|
||||
))
|
||||
)
|
||||
)
|
||||
;; If a block exists and we're in it, return the list of its start and
|
||||
;; end
|
||||
(if (and block-start (and (> position block-start)
|
||||
(< position block-end)))
|
||||
(list block-start block-end)
|
||||
|
||||
;; Reasons for not being in a block:
|
||||
;; 1. We're outside the block
|
||||
;; 2. There are no blocks in the buffer.
|
||||
;; 3. We're actually in the parameter section of the block, but
|
||||
;; the preceding code compared us with the previous block
|
||||
;;
|
||||
;; We need to be certain we're not in case 3.
|
||||
|
||||
;; Go to the end of the block we we just looked at or the first
|
||||
;; character.
|
||||
(goto-char (if block-end block-end 1))
|
||||
;; Look for the next block start
|
||||
(let ((next-block-start (re-search-forward
|
||||
enode-block-start-regexp nil t))
|
||||
next-block-start-size)
|
||||
;; If there is one, determine its size and see if were in the
|
||||
;; middle of it.
|
||||
(if (and next-block-start
|
||||
(setq next-block-start-size (length (match-string 0)))
|
||||
(and (> position (- next-block-start next-block-start-size))
|
||||
(< position next-block-start)
|
||||
))
|
||||
|
||||
;; If we are in it, move point on a bit and try again.
|
||||
(progn
|
||||
(goto-char (+ position next-block-start-size))
|
||||
(enode-block-bounds)
|
||||
)
|
||||
;; Otherwise we're on a wild goose chase.
|
||||
nil)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-line-number ()
|
||||
"A function to tell you which line you're on in the PL/SQL block"
|
||||
;; (interactive)
|
||||
|
||||
(let ((bounds (enode-block-bounds)))
|
||||
(if bounds
|
||||
(+ (count-lines (car bounds) (point))
|
||||
(if (looking-at "^") 1 0))
|
||||
bounds)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-goto-line (line-numb &optional char-numb)
|
||||
"A function to bring the point to a specific line in the named or anonymous PL/SQL block
|
||||
Produces an error if in neither.
|
||||
The optional argument CHAR-NUMB also brings you to the column"
|
||||
(interactive (list (read-from-minibuffer "Line: ")
|
||||
(read-from-minibuffer "Character: ")))
|
||||
|
||||
;; Go to the line where the block starts...
|
||||
(goto-char (car (enode-block-bounds)))
|
||||
|
||||
;; Move the the LINE-NUMBth line.
|
||||
(beginning-of-line (string-to-number line-numb))
|
||||
|
||||
;; If we want to go to the column, move to it too.
|
||||
(if (not (equal char-numb ""))
|
||||
(forward-char (- (string-to-number char-numb) 1) )
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-goto-pasted-line (pasted-line)
|
||||
"A function to navigate to a specific line and column of a PL/SQL block
|
||||
using the <linenumber>/<columnnuber> notation (e.g. 679/13)"
|
||||
(interactive (list (read-from-minibuffer "Line: ")))
|
||||
(let ((my-line (car (split-string pasted-line "/")))
|
||||
(my-char (cadr (split-string pasted-line "/")))
|
||||
)
|
||||
(enode-goto-line my-line my-char)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-pls-compile ()
|
||||
"A function to compile a named or anonymous PL/SQL block"
|
||||
(interactive)
|
||||
|
||||
;; Determine the range of the enclosing block
|
||||
;; Prepare a variable for the full statement
|
||||
;; Get the process buffer to send it to.
|
||||
(let ((compilable-region (enode-block-bounds))
|
||||
full-statement
|
||||
(sql-process (get-buffer-process "*SQL*")))
|
||||
|
||||
;; If we're in a valid block...
|
||||
(if compilable-region
|
||||
|
||||
;; ... prepare the statement, including a "SHOW ERRORS" command if
|
||||
;; we're dealing with a named block (i.e. a "CREATE..." statement)
|
||||
(progn
|
||||
(setq full-statement
|
||||
(format "%s\n/\n%s"
|
||||
(buffer-substring (car compilable-region)
|
||||
(car (cdr compilable-region)))
|
||||
(save-excursion
|
||||
(let (start-str)
|
||||
(setq start-str
|
||||
(re-search-backward enode-declare-regexp
|
||||
nil t))
|
||||
(if start-str
|
||||
""
|
||||
"show errors\n"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; Send the statement to the process
|
||||
(comint-send-string sql-process full-statement)
|
||||
)
|
||||
)
|
||||
|
||||
;; Display the results
|
||||
(display-buffer (get-buffer "*SQL*") t)
|
||||
)
|
||||
)
|
||||
|
||||
;; Some handy PL/SQL template builders.
|
||||
(defun enode-new-pls-package (pkg-name)
|
||||
"A command to create a PL/SQL package, taking only it's name in PKG-NAME.
|
||||
It creates a file (in the current buffer's location) using the name. It then
|
||||
creates the outline of both a package spec and a package body, adding helpful
|
||||
\"show errors\" commands along the way."
|
||||
;; Get the name of the package.
|
||||
(interactive "sPackage name: ")
|
||||
;; Set the name of the file containing the package.
|
||||
(let ((filename
|
||||
(concat (file-name-directory (buffer-file-name))
|
||||
"/" (downcase pkg-name) ".pls")
|
||||
))
|
||||
;; If the file already exists, we have a problem...
|
||||
(if (file-exists-p filename)
|
||||
;; ... go no further.
|
||||
(error (format "File (%s) for package already exists" filename))
|
||||
|
||||
;; Open the file
|
||||
(find-file-other-window filename)
|
||||
|
||||
;; Create the package spec outline
|
||||
(insert (format "\n"))
|
||||
(insert (format "create or replace package %s is\n\n" pkg-name))
|
||||
(insert (format "end %s;\n/\n\n" pkg-name))
|
||||
;; Add a little for compilation purposes (i.e. when the file is being
|
||||
;; run as a script)
|
||||
(insert (format "show errors;\n\n"))
|
||||
|
||||
;; Create the package body outline
|
||||
(insert (format "create or replace package body %s is\n\n" pkg-name))
|
||||
(insert (format "end %s;\n/\n\n" pkg-name))
|
||||
(insert (format "show errors;\n"))
|
||||
|
||||
;; Indent the file as preferred
|
||||
(pls-indent-region (point-min) (point-max))
|
||||
;; Adjust the code's case as preferred.
|
||||
(pls-adjust-case-region (point-min) (point-max))
|
||||
|
||||
;; Go to the first empty line of code in the package spec.
|
||||
(goto-char (search-backward
|
||||
(format "create or replace package %s is" pkg-name))
|
||||
)
|
||||
(forward-line 1)
|
||||
(pls-tab)
|
||||
(end-of-line)
|
||||
|
||||
;; Save the file and return to the user.
|
||||
(save-buffer)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-format-parameters (params-list)
|
||||
"A function to take a list of PL/SQL parameter specs and return them
|
||||
as a string that would properly be a set of PL/SQL function/procedure
|
||||
parameters.
|
||||
A parameter spec is itself a list of the following format:
|
||||
(param-name param-direction by-ref data-type default-value)
|
||||
where
|
||||
PARAM-NAME is self-explanatory;
|
||||
PARAM-DIRECTION is either NIL, \"IN\", \"OUT\" or \"IN OUT\". If NIL, it's
|
||||
not used;
|
||||
BY-REF is either NIL or T. If PARAM-DIRECTION is neither \"OUT\"
|
||||
nor \"IN OUT\", this value is meaningless;
|
||||
DATA-TYPE is the PL/SQL data type of the parameter or a reference to
|
||||
a table column;
|
||||
DEFAULT-VALUE is the default value for the parameter. If it's NIL, it's not
|
||||
used."
|
||||
;; Localise the passed list of parameter definitions.
|
||||
(let ((local-params-list params-list)
|
||||
;; Prepare the actual string to return
|
||||
params-string)
|
||||
;; For as long as there is a list of parameters...
|
||||
(while local-params-list
|
||||
;; If the string to return has something, append a comma and a newline
|
||||
;; to it. Otherwise, initialise it.
|
||||
(setq params-string (if params-string (format "%s,\n" params-string) ""))
|
||||
;; Grab the parameter at the top of the list
|
||||
(let ((current-param (car local-params-list)))
|
||||
;; Set the string to return to...
|
||||
(setq params-string
|
||||
(format "%s%s%s%s%s"
|
||||
;; what it is, followed by...
|
||||
params-string
|
||||
;; the name of the new parameter, following by...
|
||||
(format "%s " (car current-param))
|
||||
;; the parameter direction, and whether it's NOCOPY,
|
||||
;; followed by...
|
||||
(if (car (cdr current-param))
|
||||
(let ((direction (car (cdr current-param)))
|
||||
(ref (car (cdr (cdr current-param)))))
|
||||
(format "%s%s "
|
||||
(car (cdr current-param))
|
||||
(if ref " NOCOPY" "")))
|
||||
"")
|
||||
;; the parameter's type, followed by...
|
||||
(setq data-type (car (cdr (cdr (cdr current-param)))))
|
||||
;; the parameter's default value, if specified.
|
||||
(if (car (cdr (cdr (cdr (cdr current-param)))))
|
||||
(format " DEFAULT %s"
|
||||
(if (string= data-type "NUMBER")
|
||||
default-value
|
||||
(format "'%s'" default-value)))
|
||||
"")
|
||||
)
|
||||
)
|
||||
)
|
||||
;; Prepare the list for the next iteration of the loop
|
||||
(setq local-params-list (cdr local-params-list))
|
||||
)
|
||||
;; Couch the parameter list in brackets.
|
||||
(format "( %s\n) " params-string)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-pls-procedure-starter
|
||||
(proc-name return-type pkg-body-point pkg-spec-point &rest passed-params)
|
||||
"A function to create a new PL/SQL procedure.
|
||||
If RETURN-TYPE is non-nil, then it creates a PL/SQL function.
|
||||
If PKG-BODY-POINT is non-nil, it creates the procedure in a PL/SQL package.
|
||||
If PKG-SPEC-POINT is non-nil, it puts a mention of it in the package spec.
|
||||
PKG-SPEC-POINT is useless if PKG-BODY-POINT is nil.
|
||||
PASSED-PARAMS is the list of parameters.
|
||||
|
||||
This function should only be called by another function that has determined
|
||||
the parameters for it programatically."
|
||||
;; The starting statement...
|
||||
(let ((start-stmt (format "%s%s%s%s%s"
|
||||
;; If we're are creating a stand-alone thing
|
||||
(if (not pkg-body-point) "create or replace " "")
|
||||
;; What the thing is
|
||||
(if return-type "function " "procedure ")
|
||||
;; Its name
|
||||
(format "%s\n" proc-name)
|
||||
;; The parameters, if any
|
||||
(if passed-params (enode-format-parameters
|
||||
passed-params) "")
|
||||
;; What it returns, if applicable.
|
||||
(if return-type (format "return %s" return-type)
|
||||
"")
|
||||
))
|
||||
;; The ending statement.
|
||||
(end-stmt (format "end %s;\n" proc-name))
|
||||
(start-point (if (not pkg-body-point)
|
||||
(point-min)
|
||||
(save-excursion
|
||||
(goto-char pkg-body-point)
|
||||
(forward-line 1)
|
||||
(point))))
|
||||
end-point
|
||||
)
|
||||
|
||||
;; Go to where we're going to put the information
|
||||
(goto-char start-point)
|
||||
|
||||
;; Insert the generated lines.
|
||||
(insert (format "\n%s is\n\n" start-stmt))
|
||||
(insert (format "begin\n\n"))
|
||||
(insert (format "%s" end-stmt))
|
||||
|
||||
(pls-indent-region start-point (point))
|
||||
(pls-adjust-case-region start-point (point))
|
||||
|
||||
;; If we're in a package and we want to expose the thing through
|
||||
;; its spec...
|
||||
(if (and pkg-body-point pkg-spec-point)
|
||||
(progn
|
||||
;; ... go to the first line after the declaration of the spec,
|
||||
(goto-char pkg-spec-point)
|
||||
(forward-line 1)
|
||||
(setq start-point (point))
|
||||
;; and insert the generated line.
|
||||
(insert (format "\n%s;\n" start-stmt))
|
||||
|
||||
(pls-indent-region start-point (point))
|
||||
(pls-adjust-case-region start-point (point))
|
||||
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-pls-function ()
|
||||
"A function to take information on a new PL/SQL function"
|
||||
;; Get the function's name
|
||||
(interactive)
|
||||
(let ((function-name (read-from-minibuffer "Function name: "))
|
||||
;; Get the return type
|
||||
(return-type (read-from-minibuffer "Function returns: "))
|
||||
;; Get the list of parameters.
|
||||
(params-list (enode-get-parameters))
|
||||
)
|
||||
;; Are we in a package?
|
||||
(let ((pkg-points (enode-in-pls-package))
|
||||
in-spec
|
||||
)
|
||||
;; If we're in a package
|
||||
(if (cdr pkg-points)
|
||||
;; Find out if we want to expose the function
|
||||
(let (have-it)
|
||||
(while (not have-it)
|
||||
(setq in-spec (read-from-minibuffer
|
||||
"In package spec? (Y/N): " "N"))
|
||||
(if (or (string= in-spec "Y") (string= in-spec "y")
|
||||
(string= in-spec "N") (string= in-spec "n"))
|
||||
(setq have-it t)
|
||||
)
|
||||
)
|
||||
(if (or (string= in-spec "N") (string= in-spec "n"))
|
||||
(setq in-spec nil)
|
||||
)
|
||||
)
|
||||
)
|
||||
;; Call enode-pls-procedure-starter with the proper parameters.
|
||||
(apply
|
||||
'enode-pls-procedure-starter
|
||||
function-name
|
||||
return-type
|
||||
(cdr pkg-points)
|
||||
(if in-spec (car pkg-points) nil)
|
||||
params-list)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-get-parameters ()
|
||||
"A function to get a list of parameters"
|
||||
(interactive)
|
||||
;; Some intialisations
|
||||
;; The list to return
|
||||
(let (params-list
|
||||
;; Whether we're done gathering parameters
|
||||
finished
|
||||
;; The name of the first parameter
|
||||
(param-name (read-from-minibuffer
|
||||
"Parameter name (blank for no more parameters): "))
|
||||
)
|
||||
|
||||
;; If the first name is blank, we came in here by accident
|
||||
(if (string= param-name "")
|
||||
(setq finished t)
|
||||
)
|
||||
|
||||
;; Until we're finished...
|
||||
(while (not finished)
|
||||
;; Get the parameter's direction
|
||||
(setq param-direction (read-from-minibuffer
|
||||
"IN, OUT, IN OUT? (blank for nothing) "))
|
||||
;; If the direction is blank, nilify it.
|
||||
(if (string= param-direction "") (setq param-direction nil))
|
||||
|
||||
;; If we're creating an OUT or IN OUT parameter, get the NOCOPY
|
||||
;; requirements
|
||||
(setq by-ref (if (or (string= param-direction "OUT")
|
||||
(string= param-direction "IN OUT"))
|
||||
(if (string= (read-from-minibuffer "NOCOPY? " "N") "Y")
|
||||
t)
|
||||
nil))
|
||||
|
||||
;; Get the return type.
|
||||
(setq data-type (read-from-minibuffer "Data type: " "NUMBER"))
|
||||
|
||||
;; Get the default value.
|
||||
(setq default-value (read-from-minibuffer "Default value: "))
|
||||
;; If the default value is blank, nilify it.
|
||||
(if (string= default-value "") (setq default-value nil))
|
||||
|
||||
;; Add the new parameter to the list
|
||||
(setq params-list
|
||||
(cons (list param-name
|
||||
param-direction
|
||||
by-ref
|
||||
data-type
|
||||
default-value)
|
||||
params-list))
|
||||
|
||||
;; Get the name of the next parameter.
|
||||
(setq param-name (read-from-minibuffer
|
||||
"Parameter name (blank for no more parameters): "))
|
||||
;; If that's blank, we're done.
|
||||
(if (string= param-name "")
|
||||
(setq finished t)
|
||||
)
|
||||
)
|
||||
|
||||
;; If we have a list of parameters, return it reversed.
|
||||
(if params-list
|
||||
(nreverse params-list)
|
||||
nil)
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-in-pls-package ()
|
||||
"A function to determine whether we're in a PL/SQL package file.
|
||||
It returns a list of (spec-start-point . body-start-point)"
|
||||
(let ((package-body-regexp
|
||||
(concat enode-create-regexp
|
||||
"package"
|
||||
enode-pls-white-space-regexp
|
||||
"body"
|
||||
enode-pls-white-space-regexp
|
||||
enode-block-name-regexp
|
||||
enode-is-as-regexp)
|
||||
)
|
||||
(package-spec-regexp
|
||||
(concat enode-create-regexp
|
||||
"package"
|
||||
enode-pls-white-space-regexp
|
||||
enode-block-name-regexp
|
||||
enode-is-as-regexp)
|
||||
)
|
||||
body-start-point
|
||||
spec-start-point
|
||||
)
|
||||
(save-excursion
|
||||
(setq body-start-point (re-search-backward package-body-regexp nil t)))
|
||||
(save-excursion
|
||||
(setq spec-start-point (re-search-backward package-spec-regexp nil t)))
|
||||
(if (and (null body-start-point) (null spec-start-point))
|
||||
nil
|
||||
(cons spec-start-point body-start-point)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun enode-pls-procedure ()
|
||||
"A function to take information on a new PL/SQL procedure"
|
||||
;; Get the procedure's name
|
||||
(interactive)
|
||||
(let ((procedure-name (read-from-minibuffer "Procedure name: "))
|
||||
;; Get the list of parameters.
|
||||
(params-list (enode-get-parameters))
|
||||
)
|
||||
;; Are we in a package?
|
||||
(let ((pkg-points (enode-in-pls-package))
|
||||
in-spec
|
||||
)
|
||||
;; If we're in a package
|
||||
(if (cdr pkg-points)
|
||||
;; Find out if we want to expose the procedure
|
||||
(let (have-it)
|
||||
(while (not have-it)
|
||||
(setq in-spec (read-from-minibuffer
|
||||
"In package spec? (Y/N): " "N"))
|
||||
(if (or (string= in-spec "Y") (string= in-spec "y")
|
||||
(string= in-spec "N") (string= in-spec "n"))
|
||||
(setq have-it t)
|
||||
)
|
||||
)
|
||||
(if (or (string= in-spec "N") (string= in-spec "n"))
|
||||
(setq in-spec nil)
|
||||
)
|
||||
)
|
||||
)
|
||||
;; Call enode-pls-procedure-starter with the proper parameters.
|
||||
(apply
|
||||
'enode-pls-procedure-starter
|
||||
procedure-name
|
||||
nil
|
||||
(cdr pkg-points)
|
||||
(if in-spec (car pkg-points) nil)
|
||||
params-list)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun pls-present-code-region (beg end &optional reverse)
|
||||
"A function to highligh a region of code. Net really necessary here, and
|
||||
I suppose it's likely to be implemented elsewhere, but I can't find it at
|
||||
present. If REVERSE is true, it unpresents the code."
|
||||
(interactive "r")
|
||||
;; What to start the highlighting with.
|
||||
(let ((present-begin "===> ")
|
||||
;; What to end the highlighting with.
|
||||
(present-end " <===")
|
||||
;; The piece of code of interest
|
||||
(code-chunk (if (not reverse)
|
||||
(buffer-substring beg end)
|
||||
(buffer-substring (+ beg 5) (- end 5)))))
|
||||
;; Remove the region passed.
|
||||
(delete-region beg end)
|
||||
;; Insert the code section again, adding or removing highlights as
|
||||
;; required.
|
||||
(insert (format "%s%s%s"
|
||||
(if reverse "" present-begin)
|
||||
code-chunk
|
||||
(if reverse "" present-end)))
|
||||
;; Return the new end position of the relevant section
|
||||
(if reverse (- end 10) (+ end 10))
|
||||
))
|
||||
|
||||
(defun pls-convert-comments (beg end &optional do-query)
|
||||
"To convert c-style comments to preferred PL/SQL style comments. Does this
|
||||
with comments from point to the end. If prefix option DO-QUERY is passed,
|
||||
user is prompted before making change."
|
||||
(interactive "r
|
||||
P")
|
||||
;; Go to the beginning of the region
|
||||
(goto-char beg)
|
||||
(setq region-end end)
|
||||
;; Look for all openings of comment blocks
|
||||
(while (re-search-forward "/\\*" region-end t)
|
||||
;; Go back two characters to determine the starting position of the comment
|
||||
(backward-char 2)
|
||||
(setq my-comment-start (point))
|
||||
|
||||
;; Determine the end position of the comment.
|
||||
(setq my-comment-end (save-excursion (re-search-forward "\\*/" nil t)))
|
||||
|
||||
;; We want to convert this comment.
|
||||
(let ((do-conv t))
|
||||
|
||||
;; If we want to ask about all the comments...
|
||||
(if do-query
|
||||
;; ...highligh the block and determine the new end position
|
||||
(let ((new-end
|
||||
(pls-present-code-region my-comment-start my-comment-end))
|
||||
;; Ask the question
|
||||
(my-ans (y-or-n-p
|
||||
"Convert this comment? ")))
|
||||
;; If the answer is "no"...
|
||||
(if (not my-ans)
|
||||
;; ... mark the do-conv flag as nil
|
||||
(setq do-conv nil))
|
||||
;; un-highlight the block
|
||||
(pls-present-code-region my-comment-start new-end t)
|
||||
))
|
||||
;; If we are to convert the block...
|
||||
(if do-conv
|
||||
(let ((current-region-size (- my-comment-end my-comment-start))
|
||||
new-region-size)
|
||||
;; ... go to the start of the comment...
|
||||
(goto-char my-comment-start)
|
||||
;; ... and delete the next two charaters (the "/*")
|
||||
(delete-char 2)
|
||||
|
||||
;; Go to the end of the block now that the first two
|
||||
;; characters have been deleted, and come back another two...
|
||||
(goto-char (- my-comment-end 4))
|
||||
;; ... and delete them too.
|
||||
(delete-char 2)
|
||||
|
||||
;; Reset the end position of this comment.
|
||||
(setq my-comment-end (point))
|
||||
|
||||
;; Use the in-built commenting function to comment out
|
||||
;; the defined region. This satisfies my requirements
|
||||
;; beautifully.
|
||||
(comment-region my-comment-start my-comment-end)
|
||||
;; Commenting this out. We need to track the change to the
|
||||
;; size of the buffer, and until I get a good example of
|
||||
;; why the unwind-protect is required, I can't cater for this.
|
||||
;; (let ((do-commenting nil))
|
||||
;; (unwind-protect
|
||||
;; (setq do-commenting (comment-region my-comment-start my-comment-end))
|
||||
;; (if (not do-commenting)
|
||||
;; (progn
|
||||
;; (goto-char my-comment-start)
|
||||
;; (beginning-of-line)
|
||||
;; (while (< (point) my-comment-end)
|
||||
;; (insert "-- ")
|
||||
;; (forward-line 1)
|
||||
;; )
|
||||
;; )
|
||||
;; )
|
||||
;; )
|
||||
;; )
|
||||
|
||||
;; Get the new region end.
|
||||
(setq new-region-size (- (point) my-comment-start))
|
||||
(setq region-end
|
||||
(+ region-end (- new-region-size current-region-size)))
|
||||
|
||||
) ;; end let
|
||||
) ;; end if
|
||||
) ;; end let
|
||||
) ;; end file
|
||||
(message "Done.")
|
||||
region-end
|
||||
)
|
||||
|
||||
(defun pls-convert-comments-buffer (&optional do-query)
|
||||
"Convert the /* ... */ comments for the whole buffer"
|
||||
(interactive "P")
|
||||
(pls-convert-comments (point-min) (point-max) do-query)
|
||||
)
|
||||
|
||||
(defun pls-prepare-for-comparison (beg end)
|
||||
"Prepare a PLSQL region for comparison. Should really be done on the whole
|
||||
buffer"
|
||||
(interactive "r")
|
||||
(pls-mode)
|
||||
(save-excursion
|
||||
;; Remove trailing spaces at the end of lines.
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "[ ]+$" end t)
|
||||
(replace-match "")
|
||||
(setq end (- end (length (match-string 0))))
|
||||
)
|
||||
;; Replace tab characters with space characters
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "[ ]+" end t)
|
||||
(replace-match " ")
|
||||
(setq end (- end (- (length (match-string 0)) 1)))
|
||||
)
|
||||
;; Convert comments. I want to make this interactive as
|
||||
;; hints probably shouldn't be converted.
|
||||
(setq end (pls-convert-comments beg end t))
|
||||
;; Change the case of the region
|
||||
(pls-adjust-case-region beg end)
|
||||
;; Indent the region
|
||||
(indent-region beg end nil)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(defun pls-prepare-for-comparison-buffer ()
|
||||
"Prepare a PLSQL buffer for comparison."
|
||||
(interactive)
|
||||
(pls-prepare-for-comparison (point-min) (point-max))
|
||||
)
|
||||
|
||||
(provide 'pls-extras)
|
||||
24
enode-lisp/sql-extras.el
Executable file
24
enode-lisp/sql-extras.el
Executable file
|
|
@ -0,0 +1,24 @@
|
|||
|
||||
(defun sql-area-add-table (table-name)
|
||||
"A simple function to add a new table to the SQL file."
|
||||
(interactive "sTable name: ")
|
||||
|
||||
(let ((table-name (upcase table-name)))
|
||||
(if (eq major-mode 'sql-mode)
|
||||
(if (progn
|
||||
(goto-char (point-min))
|
||||
(re-search-forward (format "^-- Table: %s$" table-name) nil t))
|
||||
(error "Table %s is already there" table-name)
|
||||
(goto-char (point-max))
|
||||
(goto-char (re-search-backward "^-- Table: .+"))
|
||||
(insert (format "-- Table: %s\n\n" table-name))
|
||||
(insert (format "desc %s\n\n" table-name))
|
||||
(insert (format "select count(*) %s\nfrom %s;\n\n"
|
||||
table-name table-name))
|
||||
)
|
||||
(error "Are you in an sql-mode buffer?")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(provide 'sql-extras)
|
||||
Loading…
Reference in a new issue