{-# 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