botlistprojects/botspider/spider/lib/haskell/src/Data/SpiderQueue/Queue.hs

   1 -- ***********************************************
   2 -- Author: Berlin Brown
   3 -- File: Queue.hs
   4 -- Date: 1/10/2008
   5 --
   6 -- Description:
   7 -- Simple Queue Binary File Format Database.
   8 --
   9 -- References:
  10 -- (1) http://hackage.haskell.org/packages/archive/binary/0.4.1/doc/html/Data-Binary.html
  11 -- (2) http://hackage.haskell.org/cgi-bin/hackage-scripts/package/utf8-string-0.2
  12 -- (3) http://hackage.haskell.org/packages/archive/bytestring/0.9.0.1/doc/html/Data-ByteString.html
  13 -- (4) http://www.haskell.org/ghc/docs/latest/html/libraries/haskell98/Time.html
  14 -- ***********************************************
  15
  16 module Data.SpiderQueue.Queue where
  17
  18 import System.IO
  19 import Control.Monad (replicateM, forM, liftM)
  20 import Data.Word
  21 import Data.Binary
  22 import Data.Binary.Get as BinaryGet
  23 import Data.Binary.Put as BinaryPut
  24 import Text.Printf
  25
  26 --
  27 -- Used qualified names for the different bytestring manipulation
  28 -- modules; using 'Import Qualified' to ensure we are using the correct function.
  29 import qualified Data.ByteString as Eager (ByteString, unpack, pack)
  30 import qualified Data.ByteString.Char8 as CharBS (pack, unpack)
  31 import qualified Data.ByteString.Lazy.Char8 as LazyC (unpack, pack)
  32 import qualified Data.ByteString.Lazy as Lazy (ByteString, unpack, pack, hPut, hGetContents)
  33
  34 magicNUMBER_U2A = 0x25D4
  35 magicNUMBER_U2B = 0xB0DB
  36
  37 majorNUMBER = 0x0001
  38 minorNUMBER = 0x0000
  39
  40 queueTAG = 0x79
  41
  42 --
  43 -- | Simple First in, First Out binary file format
  44 data SpiderQueue = SpiderQueue {
  45       magicNumberA :: Word16,
  46       magicNumberB :: Word16,
  47       majorVers :: Word16,
  48       minorVers :: Word16,
  49       queueSize :: Word32,
  50       queue :: [QueueObject]
  51 }
  52 data QueueObject = QueueObject {
  53       segtag :: Word8,
  54       dbseglen :: Word32,
  55       dbsegment :: Lazy.ByteString,
  56       -- Posix time
  57       ptime :: Word32
  58 }
  59
  60 instance Show SpiderQueue where
  61     show db =  "<<<Database Content>>>\n" ++
  62                printf " Magic: %X %X\n" (magicNumberA db)
  63                           (magicNumberB db)
  64
  65 instance Show QueueObject where
  66     show obj =  "<<<Queue Content>>>\n" ++
  67                printf " Tag: %X Len: %d\n" (segtag obj)
  68                           (dbseglen obj)
  69
  70 instance Binary QueueObject where
  71     put dbq = do
  72       BinaryPut.putWord8 (segtag dbq)
  73       BinaryPut.putWord32be (dbseglen dbq)
  74       BinaryPut.putLazyByteString (dbsegment dbq)
  75       BinaryPut.putWord32be (ptime dbq)
  76     get = do
  77       tag <- getWord8
  78       len <- getWord32be
  79       segdata <- BinaryGet.getLazyByteString (fromIntegral len)
  80       t <- getWord32be
  81       return (QueueObject {
  82                 segtag=tag, dbseglen=len,
  83                 dbsegment=segdata, ptime=t
  84               })
  85
  86 instance Binary SpiderQueue where
  87     put dbq = do
  88       BinaryPut.putWord16be (magicNumberA dbq)
  89       BinaryPut.putWord16be (magicNumberB dbq)
  90       BinaryPut.putWord16be (majorVers dbq)
  91       BinaryPut.putWord16be (minorVers dbq)
  92       BinaryPut.putWord32be (queueSize dbq)
  93       -- @see mapM: Monad m => (a -> m b) -> [a] -> m [b]
  94       (mapM_ put (queue dbq))
  95     get = do
  96       magicnumbera <- BinaryGet.getWord16be
  97       magicnumberb <- BinaryGet.getWord16be
  98       major <- BinaryGet.getWord16be
  99       minor <- BinaryGet.getWord16be
 100       len <- BinaryGet.getWord32be
 101       -- *******************************
 102       -- Get the remaining byte string data,
 103       -- So that we can use lazy bytestring to load to load the
 104       -- the data types.
 105       -- Also: queueData <- forM [1..len] (const (get :: Get QueueObject))
 106       -- *******************************
 107       queueData <- replicateM (fromIntegral len) (get :: Get QueueObject)
 108       return (SpiderQueue {magicNumberA=magicnumbera,
 109                            magicNumberB=magicnumberb,
 110                            majorVers=major,
 111                            minorVers=minor,
 112                            queueSize=len,
 113                            queue=queueData
 114                           })
 115
 116 -- *********************************************************
 117 {-
 118   Utility Functions
 119  -}
 120 -- *********************************************************
 121 initSpiderQueue :: [QueueObject] -> SpiderQueue
 122 initSpiderQueue objlist = SpiderQueue {
 123                             magicNumberA=magicNUMBER_U2A,
 124                             magicNumberB=magicNUMBER_U2B,
 125                             majorVers=majorNUMBER,
 126                             minorVers=minorNUMBER,
 127                             queueSize=(fromIntegral (length objlist)),
 128                             queue=objlist
 129                           }
 130
 131 initQueueObject :: String -> Integer -> QueueObject
 132 initQueueObject obj t = QueueObject {
 133                         segtag=(fromIntegral queueTAG),
 134                         dbseglen=(fromIntegral lenbs),
 135                         dbsegment=bs,
 136                         ptime=pt }
 137                   where
 138                     bs = LazyC.pack obj
 139                     lenbs = length . LazyC.unpack $ bs
 140                     pt = (fromIntegral t)