Safe Haskell | None |
---|---|
Language | Haskell2010 |
- logsrc :: Text
- maxChunkSize :: Num a => a
- bufSize :: Int
- fileBuffering :: BufferMode
- type StatisticsMap = Map ByteString (Int, Int)
- data DumpConfig = DumpConfig {}
- data RestoreConfig = RestoreConfig {}
- dump :: (MonadIO m, MonadFail m, MonadBaseControl IO m) => ReaderT DumpConfig m ()
- hDump :: (MonadIO m, MonadFail m) => Handle -> ReaderT DumpConfig (MaybeT m) ()
- makeHeader :: MonadIO m => ReaderT DumpConfig m HeaderV1
- data ThreadedDump = ThreadedDump {}
- dumpTables :: (MonadIO m, MonadFail m) => Handle -> ReaderT DumpConfig (MaybeT m) ()
- publishTables :: (MonadIO m, MonadFail m) => ReaderT ThreadedDump m ()
- publishTable :: (MonadIO m, MonadFail m) => Int -> String -> ReaderT ThreadedDump m Int
- startWorkerThreads :: (MonadIO m, MonadFail m) => ReaderT ThreadedDump m ()
- startWorkerThread :: (MonadIO m, MonadFail m) => ReaderT ThreadedDump m ()
- dumpThread :: (MonadIO m, MonadFail m) => Handle -> SQLHENV -> SQLHDBC -> ReaderT ThreadedDump m ()
- copyTmpToDumpFile :: Handle -> Handle -> IO ()
- waitForWorkToEnd :: MonadIO m => ReaderT ThreadedDump m ()
- allocHandleT :: (MonadIO m, MonadFail m) => TQueue (SQLSMALLINT, SQLHANDLE, TMVar SQLHANDLE) -> STM (m ())
- allocHandleReq :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> ReaderT ThreadedDump m SQLHANDLE
- data SingleOrMulti
- dumpConfig :: SingleOrMulti -> DumpConfig
- allocHandleSM :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> ReaderT SingleOrMulti m SQLHANDLE
- collectColumnsInfoSM :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> String -> ReaderT SingleOrMulti m [ColumnInfo]
- dumpTable :: (MonadIO m, MonadFail m) => Handle -> SQLHDBC -> (Int, Int) -> String -> ReaderT SingleOrMulti m (Int, Int)
- debugFieldInfo :: FieldInfoV1 -> IO ()
- extractSchema :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> ReaderT SingleOrMulti m SchemaV1
- extractSchemaFields :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> ReaderT SingleOrMulti m [FieldInfoV1]
- makeFieldInfo :: ColumnInfo -> FieldInfoV1
- dumpTableData :: (MonadIO m, MonadFail m) => Handle -> SQLHDBC -> SchemaV1 -> ReaderT SingleOrMulti m (Int, Int)
- dumpRecord :: (MonadIO m, MonadFail m) => Handle -> SQLHSTMT -> SchemaV1 -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> (Int, Int) -> ReaderT SingleOrMulti m (Int, Int)
- logStatistics :: (MonadIO m, MonadFail m) => ByteString -> Int -> Int -> ReaderT SingleOrMulti m ()
- logstats :: (MonadIO m, MonadFail m) => ByteString -> (Int, Int) -> ReaderT SingleOrMulti m ()
- readSizesVar :: SingleOrMulti -> TVar StatisticsMap
- readStartTime :: SingleOrMulti -> TimeSpec
- dumpField :: (MonadIO m, MonadFail m) => Handle -> SQLHSTMT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> Int -> (SQLSMALLINT, FieldInfoV1) -> m Int
- data DumpFieldSpec = DumpFieldSpec {}
- dumpField' :: (MonadIO m, MonadFail m) => ReaderT DumpFieldSpec m Int
- dumpVarLenField :: (MonadIO m, MonadFail m) => SQLSMALLINT -> ReaderT DumpFieldSpec m Int
- octetLengthOfChunkSize :: (Num a, Monad m) => ReaderT DumpFieldSpec m a
- dumpChunk :: (MonadIO m, MonadFail m) => Int -> (Int, Int) -> ReaderT DumpFieldSpec m (Int, Int)
- dumpNullIndicator :: MonadIO m => NullIndicator -> Int -> ReaderT DumpFieldSpec m Int
- dumpChunk' :: (MonadIO m, MonadFail m) => Int -> Int -> ReaderT DumpFieldSpec m Int
- dumpFixedField :: (MonadIO m, MonadFail m) => SQLSMALLINT -> ReaderT DumpFieldSpec m Int
- dumpFixedField' :: (MonadIO m, MonadFail m) => SQLSMALLINT -> Int -> SQLLEN -> ReaderT DumpFieldSpec m Int
- dumpUnknownFieldType :: (MonadIO m, MonadFail m) => ReaderT DumpFieldSpec m Int
- makeSelectSql :: (MonadIO m, MonadFail m) => SchemaV1 -> m String
- restore :: (MonadIO m, MonadFail m, MonadBaseControl IO m) => ReaderT RestoreConfig m ()
Documentation
maxChunkSize :: Num a => a Source #
the maximum size of a chunk of variable length value
fileBuffering :: BufferMode Source #
file buffering mode
type StatisticsMap = Map ByteString (Int, Int) Source #
keep statistics by statement handle; for each handle record the number of records dumped so far and the total size dumped so far
data DumpConfig Source #
dump database options
DumpConfig | |
|
data RestoreConfig Source #
restore database options
RestoreConfig | |
|
dump :: (MonadIO m, MonadFail m, MonadBaseControl IO m) => ReaderT DumpConfig m () Source #
dump a schema from an ODBC database to a binary file
hDump :: (MonadIO m, MonadFail m) => Handle -> ReaderT DumpConfig (MaybeT m) () Source #
dumps the database schema to the file represented by the given handle
makeHeader :: MonadIO m => ReaderT DumpConfig m HeaderV1 Source #
create the header of the dump file
data ThreadedDump Source #
global environment for dumping tables in parallel
ThreadedDump | |
|
dumpTables :: (MonadIO m, MonadFail m) => Handle -> ReaderT DumpConfig (MaybeT m) () Source #
dumps all tables in a schema, on a given connection
publishTables :: (MonadIO m, MonadFail m) => ReaderT ThreadedDump m () Source #
publish the tables to the chanel read by the worker threads
publishTable :: (MonadIO m, MonadFail m) => Int -> String -> ReaderT ThreadedDump m Int Source #
monadic action to publish the table name on the tables channel
startWorkerThreads :: (MonadIO m, MonadFail m) => ReaderT ThreadedDump m () Source #
start the worker threads; each worker thread will dump data in a temporary file, then will append the contents of the temporary file to the contents of the dump file; the append is done synchronized with the other worker threads, so only one worker thread will append to the main dump file
startWorkerThread :: (MonadIO m, MonadFail m) => ReaderT ThreadedDump m () Source #
start one worker thread
dumpThread :: (MonadIO m, MonadFail m) => Handle -> SQLHENV -> SQLHDBC -> ReaderT ThreadedDump m () Source #
the worker thread; gets a table name from the tables channel and dumps the data in the temporary file; in the end, appends the temporary file contents to the end of the dump file contents
copyTmpToDumpFile :: Handle -> Handle -> IO () Source #
finalizes the dump by copying the temporary file back into the dump file
waitForWorkToEnd :: MonadIO m => ReaderT ThreadedDump m () Source #
wait for worker threads to complete the work
allocHandleT :: (MonadIO m, MonadFail m) => TQueue (SQLSMALLINT, SQLHANDLE, TMVar SQLHANDLE) -> STM (m ()) Source #
creates an IO action inside a STM monad to allocate a new handler in the current thread
allocHandleReq :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> ReaderT ThreadedDump m SQLHANDLE Source #
make a handle alloc request to the main thread and wait for result
data SingleOrMulti Source #
environment for either single threaded or multi threaded dump
dumpConfig :: SingleOrMulti -> DumpConfig Source #
extract dumpConfig from a SingleOrMulti
structure
allocHandleSM :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> ReaderT SingleOrMulti m SQLHANDLE Source #
either directly alloc handle or call allocHandleReq
to alloc a handle deppending
on it is run on a threaded or non threaded environment
:: (MonadIO m, MonadFail m) | |
=> SQLHDBC | connection handle |
-> String | schema name |
-> String | table name |
-> ReaderT SingleOrMulti m [ColumnInfo] |
workarround for unixODBC bug that requires that all handles should be allocated on the main thread
dumpTable :: (MonadIO m, MonadFail m) => Handle -> SQLHDBC -> (Int, Int) -> String -> ReaderT SingleOrMulti m (Int, Int) Source #
dumps a single table
debugFieldInfo :: FieldInfoV1 -> IO () Source #
logs the content of a FieldInfo
structure
extractSchema :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> ReaderT SingleOrMulti m SchemaV1 Source #
extract schema infromation from the database, using an existing db connection
extractSchemaFields :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> ReaderT SingleOrMulti m [FieldInfoV1] Source #
extract the fields information from the database
makeFieldInfo :: ColumnInfo -> FieldInfoV1 Source #
transforms a ColumnInfo
structure into a FieldInfoV1
structure
dumpTableData :: (MonadIO m, MonadFail m) => Handle -> SQLHDBC -> SchemaV1 -> ReaderT SingleOrMulti m (Int, Int) Source #
dump the table records to the file, one by one; returns the (number of records, size in bytes) of dumped data
dumpRecord :: (MonadIO m, MonadFail m) => Handle -> SQLHSTMT -> SchemaV1 -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> (Int, Int) -> ReaderT SingleOrMulti m (Int, Int) Source #
dumps the data of one record into the file; it returns the (number of records, total bytes dumped)
logStatistics :: (MonadIO m, MonadFail m) => ByteString -> Int -> Int -> ReaderT SingleOrMulti m () Source #
monadic action that logs the data dumped until now; it uses a map that records the count of records and the size dumped for each statement handle
logstats :: (MonadIO m, MonadFail m) => ByteString -> (Int, Int) -> ReaderT SingleOrMulti m () Source #
uncurried form of (lotStatistics
hstmt)
readSizesVar :: SingleOrMulti -> TVar StatisticsMap Source #
get the TVar
StatiscsMap
from the environment
readStartTime :: SingleOrMulti -> TimeSpec Source #
get the start time from the environment
dumpField :: (MonadIO m, MonadFail m) => Handle -> SQLHSTMT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> Int -> (SQLSMALLINT, FieldInfoV1) -> m Int Source #
dump data of a single field; adds the size of dumped data to the total size received as parameter
data DumpFieldSpec Source #
dump field data parameters
DumpFieldSpec | |
|
dumpField' :: (MonadIO m, MonadFail m) => ReaderT DumpFieldSpec m Int Source #
ReaderT monadic action that dumps a field into the dump file; returns the total dump size, adding to the prior size the size in bytes of dumped data
dumpVarLenField :: (MonadIO m, MonadFail m) => SQLSMALLINT -> ReaderT DumpFieldSpec m Int Source #
dumps a variable field length; the variable field length will be dumped in chunks each chunk having two fields: a length of the chunk and the actual data of the chunk. The length of the chunk will be encoded on one, two or four bytes, depending on the maximum chunk length and the maximum length of the field taken from the table's schema.
octetLengthOfChunkSize :: (Num a, Monad m) => ReaderT DumpFieldSpec m a Source #
the octet length of the chunk size; it is calculated based on the transfer buffer size and on the maxumum size of the field.
dumpChunk :: (MonadIO m, MonadFail m) => Int -> (Int, Int) -> ReaderT DumpFieldSpec m (Int, Int) Source #
dumps a chunk of data; increments the current size with the number of octets dumped and returns this value
dumpNullIndicator :: MonadIO m => NullIndicator -> Int -> ReaderT DumpFieldSpec m Int Source #
dumpChunk' :: (MonadIO m, MonadFail m) => Int -> Int -> ReaderT DumpFieldSpec m Int Source #
dumps a chunk of data for a non null field; increments the current size with the number of octets dumped and returns this value
dumpFixedField :: (MonadIO m, MonadFail m) => SQLSMALLINT -> ReaderT DumpFieldSpec m Int Source #
dumps a fixed length field; the buffer length of the field will be taken from the description of the field in the table's schema; the dumped data will only contain the data of the field; the first parameter represents the ODBC C data type of the data to be read from the database
dumpFixedField' :: (MonadIO m, MonadFail m) => SQLSMALLINT -> Int -> SQLLEN -> ReaderT DumpFieldSpec m Int Source #
dumps the data of a not null field
dumpUnknownFieldType :: (MonadIO m, MonadFail m) => ReaderT DumpFieldSpec m Int Source #
dumps a field of an unknown type; the field will be converted to SQL_C_CHAR and dumped as a string of characters
makeSelectSql :: (MonadIO m, MonadFail m) => SchemaV1 -> m String Source #
create the select for dumping table data
restore :: (MonadIO m, MonadFail m, MonadBaseControl IO m) => ReaderT RestoreConfig m () Source #
read the binary dump of a database and restores it in a destination ODBC data source