ta-0.1: Database/TA/Core/Infraestructura.hs
{-# options -fglasgow-exts #-}
{-# language OverlappingInstances #-}
{- |
Infraestructura necesaria para facilitar
las interacción.
Modo de uso:
(1) Prepare con : h_ta_query_desc_tmp
(2) Analice q con : describirConsulta q
(3) Obtenga resultados con :
Leonel Fonseca. 2010.
-}
module Database.TA.Core.Infraestructura
( exnAt
, concatM
, collcatM
, describirConsulta
, revertir
)
where
import Database.TA.Core.Nucleo ( QueryColInfo (..) )
import Database.TA.Helper.Text
import Database.Oracle.Enumerator
import Control.Monad (liftM)
{- |
Rutina para atrapar, comentar
(la hilera @msg@ se usa como prefijo del mensaje)
y relanzar excepciones.
-}
act `exnAt` msg = catchDB act (reportRethrowMsg msg)
{- |
El trozo de código
r <- mapM (xQ ps) bindings
return $ concat r
es equivalente a
r <- (liftM concat . sequence) (map (xQ ps) bindings)
y puede resumirse aplicando la factorización de concatDBM
concatDBM (xQ ps) bindings
-}
concatM :: (Monad m) => (a1 -> m [a]) -> [a1] -> m [a]
concatM f = liftM concat . sequence . map f
{- |
Colecciona y concatena el resultado de aplicar dos
acciones monádicas.
-}
collcatM :: (Monad m, Monad m1) => [m1 (m [a])] -> m1 (m [a])
collcatM = liftM (liftM concat . sequence) . sequence
{- |
Se utiliza para aplicar una función de iteración
con acumulación al frente de una lista
y revierte el orden del acumulador.
-}
revertir :: (Monad m) => (a1 -> a) -> [a1] -> m [a]
revertir f = return . reverse . map f
-- | Los metadatos que describen una consulta.
describirConsulta :: String -> DBM mark Session [QueryColInfo]
describirConsulta q = do
tablaTmp `exnAt` "describirConsulta.tablaTmp"
describirQuery q `exnAt` "describirConsulta.describirQuery"
qQueryColInfo `exnAt` "describirConsulta.qQueryColInfo"
-- | Estas funciones no se exportan porque deben utilizarse
-- de forma conjunta, tal y como se hace en la acción
-- 'describirConsulta'.
{- | Construye una tabla temporal
llamada 'ta_query_desc_tmp' para mantener
los resultados de la descripción de una consulta.
-}
tablaTmp :: DBM mark Session ()
tablaTmp = execDDL texto_h_tmp
{- | 'describirConsulta' obtiene la información de las
columnas resultantes al analizar la consulta q.
Precaución: Si se envían instrucciones DDL
se ejecutarán inmediatamente, en lugar de ser analizadas.
-}
describirQuery :: String -> DBM mark Session ()
describirQuery q = execDDL $ cmdbind texto_analizar [bindP q]
{- Nos interesan estos datos:
col_type Int
col_max_len Int
col_name String
col_schema_name String
col_precision Int
col_scale Int
col_null_ok Int (lo convertiremos en Bool)
-}
qQueryColInfo :: DBM mark Session [QueryColInfo]
qQueryColInfo = do
r <- doQuery s ite []
return $ reverse $ map toQueryColInfo r
where
toQueryColInfo :: (Int,Int,String,Maybe String,Int,Int,Int)
-> QueryColInfo
toQueryColInfo (a,b,c,e,d,f,g) =
QueryColInfo a b c e d f (if g==1 then True else False)
ite :: (Monad m) =>
Int -> Int -> String -> Maybe String -> Int -> Int -> Int ->
IterAct m [(Int, Int, String, Maybe String, Int, Int, Int)]
ite a b c d e f g acc = result' ( (a,b,c,d,e,f,g):acc )
s = "select /* TABDInfraestructura - desc. query */ \
\ col_type \
\ , col_max_len \
\ , col_name \
\ , col_schema_name \
\ , col_precision \
\ , col_scale \
\ , col_null_ok \
\ from ta_query_desc_tmp \
\ where dbms_session.unique_session_id \
\ = unique_session_id \
\order by col_position"
-- | Textos de las consultas.
texto_h_tmp :: String
texto_h_tmp =
"declare \
\ pragma autonomous_transaction; \
\ /* con persistencia limitada a una transacción. */ \
\ construirTabla varchar2(600) := \
\ 'create global temporary table ta_query_desc_tmp' \
\ ||' ( unique_session_id VARCHAR2(24) ' \
\ ||' , col_position INTEGER ' \
\ ||' , col_type INTEGER ' \
\ ||' , col_max_len INTEGER ' \
\ ||' , col_name VARCHAR2(32) ' \
\ ||' , col_name_len INTEGER ' \
\ ||' , col_schema_name VARCHAR2(32) ' \
\ ||' , col_schema_name_len INTEGER ' \
\ ||' , col_precision INTEGER ' \
\ ||' , col_scale INTEGER ' \
\ ||' , col_charsetid INTEGER ' \
\ ||' , col_charsetform INTEGER ' \
\ ||' , col_null_ok INTEGER ) ' \
\ ||' on commit delete rows'; \
\ existe binary_integer := 0; \
\ privilegiado binary_integer := 0; \
\begin \
\ /* Puede crear una tabla temporal? */ \
\ begin \
\ select 1 \
\ into privilegiado \
\ from user_sys_privs \
\ where privilege = 'CREATE TABLE'; \
\ exception \
\ when no_data_found then null; \
\ when others then raise; \
\ end; \
\ /* Es necesario crear una tabla temporal? */ \
\ begin \
\ select 1 \
\ into existe \
\ from user_tables \
\ where table_name = 'TA_QUERY_DESC_TMP'; \
\ exception \
\ when no_data_found then null; \
\ when others then raise; \
\ end; \
\ /* La transacción autónoma termina \
\ con el execute immediate o el rollback. */ \
\ if existe = 0 then \
\ if privilegiado = 1 then \
\ execute immediate construirTabla; \
\ else \
\ rollback; \
\ raise_application_error (-20000, \
\ 'Error: el usuario ' || user || ' carece de ' \
\ ||'privilegios para crear una tabla temporal.');\
\ end if; \
\ else \
\ rollback; \
\ end if; \
\end;"
-- | Dentro del siguiente texto hay una variable de substitución
-- con el nombre :1. Debe asociarse con el texto de una
-- consulta por analizar.
texto_analizar :: String
texto_analizar =
"declare \
\ /* Alimenta la tabla ta_query_desc_tmp \
\ con la información sobre una consulta :1. */ \
\ asa integer; \
\ canColumnas integer; \
\ queryInfo dbms_sql.desc_tab; \
\ nullAccepted integer; \
\ idSesion varchar2(24) \
\ := dbms_session.unique_session_id; \
\begin \
\ /* Asegura que no hayan descripciones previas. */ \
\ delete from ta_query_desc_tmp; \
\ /* Establece área de trabajo */ \
\ asa := dbms_sql.open_cursor; \
\ /* Reconoce la hilera con el motor SQL. */ \
\ /* :1 debe ser el texto de una consulta. */ \
\ dbms_sql.parse(asa, :1, dbms_sql.native); \
\ /* Obtiene la descripción en queryInfo */ \
\ dbms_sql.describe_columns(asa, canColumnas, queryInfo);\
\ /* Transforma la descripción al insertarla en una \
\ tabla para facilitar su recuperación con una \
\ consulta sencilla. \
\ Preservamos idSession para poder tener \
\ sesiones concurrentes. */ \
\ for i in queryInfo.first..queryInfo.Last loop \
\ nullAccepted := case queryInfo(i).col_null_ok \
\ when true then 1 \
\ else 0 \
\ end; \
\ insert into ta_query_desc_tmp values \
\ ( idSesion \
\ , i \
\ , queryInfo(i).col_type \
\ , queryInfo(i).col_max_len \
\ , queryInfo(i).col_name \
\ , queryInfo(i).col_name_len \
\ , queryInfo(i).col_schema_name \
\ , queryInfo(i).col_schema_name_len \
\ , queryInfo(i).col_precision \
\ , queryInfo(i).col_scale \
\ , queryInfo(i).col_charsetid \
\ , queryInfo(i).col_charsetform \
\ , nullAccepted \
\ ); \
\ end loop; \
\ /* Cierra el área de trabajo. */ \
\ dbms_sql.close_cursor(asa); \
\end;"
-- eof