module DVD.DVDRead
(
DVDRead
, File
, Status
, Offset
, Size
, Title
, ReadDomain(..)
, VolumeIdentifier
, VolumeSetIdentifier
, dvdRead
, fileStat
, getUDFCacheLevel
, setUDFCacheLevel
, udfVolumeInfo
, isoVolumeInfo
, blockSize
, file
, size
, readBlocks
, readBytes
, readVMGInfoFile
, readVMGInfoBackupFile
, readVMGMenu
, readVTSInfoFile
, readVTSInfoBackupFile
, readVTSMenu
) where
import Control.Monad.State
import Data.ByteString hiding (map)
import Data.ByteString.Unsafe
import qualified Data.ByteString.Char8 as C
import Foreign
import Foreign.C
import Foreign.C.Types
newtype DVDReader = DVDReader (ForeignPtr (DVDReader))
withDVDReader :: DVDReader -> (Ptr DVDReader -> IO b) -> IO b
withDVDReader (DVDReader fptr) = withForeignPtr fptr
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum = fromIntegral . fromEnum
toDVDReader :: Ptr DVDReader -> IO DVDReader
toDVDReader ptr = newForeignPtr p_DVDClose ptr >>= return . DVDReader
foreign import ccall "&DVDClose"
p_DVDClose :: FunPtr (Ptr DVDReader -> IO ())
toMaybeDVDReader :: Ptr DVDReader -> IO (Maybe DVDReader)
toMaybeDVDReader ptr | ptr == nullPtr = return Nothing
| otherwise = toDVDReader ptr >>= return . Just
dvdOpen :: (FilePath) -> IO ((Maybe DVDReader))
dvdOpen a1 =
withCString a1 $ \a1' ->
dvdOpen'_ a1' >>= \res ->
toMaybeDVDReader res >>= \res' ->
return (res')
newtype DVDRead a = DVDRead (StateT DVDReader IO a)
deriving (Functor, Monad, MonadIO)
runDVDRead (DVDRead (StateT action)) = action
dvdRead :: FilePath
-> DVDRead a
-> IO a
dvdRead file (DVDRead (StateT action)) =
do md <- dvdOpen file
case md of
Nothing -> ioError $ userError ("Cannot open " ++ file)
Just dvd -> do (a,DVDReader d) <- action dvd
finalizeForeignPtr d
return a
getUDFCacheLevel :: DVDRead Bool
getUDFCacheLevel = DVDRead $ StateT (\s -> do i <- dvdUDFCacheLevel s (1)
return (toEnum i,s)
)
setUDFCacheLevel :: Bool -> DVDRead ()
setUDFCacheLevel b = DVDRead $ StateT (\s -> do dvdUDFCacheLevel s (fromEnum b)
return ((),s)
)
dvdUDFCacheLevel :: (DVDReader) -> (Int) -> IO ((Int))
dvdUDFCacheLevel a1 a2 =
withDVDReader a1 $ \a1' ->
let {a2' = fromIntegral a2} in
dvdUDFCacheLevel'_ a1' a2' >>= \res ->
let {res' = fromIntegral res} in
return (res')
newtype DiscID = DiscID ByteString
ptr2DiscID :: Ptr a -> IO DiscID
ptr2DiscID p = packCStringLen (castPtr p,16) >>= return . DiscID
discID :: DVDRead (Maybe DiscID)
discID = DVDRead $ StateT
(\s ->
do p <- mallocBytes 16
i <- withDVDReader s (\q -> c_DVDDiscID q p)
if i == 1
then do free p
return (Nothing,s)
else do id <- ptr2DiscID p
free p
return (Just id,s)
)
data ReadDomain = InfoFile
| InfoBackupFile
| MenuVobs
| TitleVobs
deriving (Enum,Eq,Read,Show)
newtype DVDFile = DVDFile (ForeignPtr (DVDFile))
withDVDFile :: DVDFile -> (Ptr DVDFile -> IO b) -> IO b
withDVDFile (DVDFile fptr) = withForeignPtr fptr
toDVDFile :: Ptr DVDFile -> IO DVDFile
toDVDFile ptr = newForeignPtr p_DVDCloseFile ptr >>= return . DVDFile
toMaybeDVDFile :: Ptr DVDFile -> IO (Maybe DVDFile)
toMaybeDVDFile ptr | ptr == nullPtr = return Nothing
| otherwise = toDVDFile ptr >>= return . Just
foreign import ccall "&DVDCloseFile"
p_DVDCloseFile :: FunPtr (Ptr DVDFile -> IO ())
newtype File a = File (StateT DVDFile DVDRead a)
deriving (Functor, Monad, MonadIO)
type Title = Word8
file :: Title
-> ReadDomain
-> File a
-> DVDRead a
file tit dom (File (StateT act)) =
DVDRead $ StateT
(\s ->
do
mf <- dvdOpenFile s tit dom
case mf of
Nothing -> do
a <- ioError $
userError ("Cannot open title " ++ (show tit))
return (a,s)
Just f -> do
((a, DVDFile g),r) <- (runDVDRead (act f)) s
finalizeForeignPtr g
return (a,r)
)
dvdOpenFile :: (DVDReader) -> (Title) -> (ReadDomain) -> IO ((Maybe DVDFile))
dvdOpenFile a1 a2 a3 =
withDVDReader a1 $ \a1' ->
let {a2' = fromIntegral a2} in
let {a3' = cFromEnum a3} in
dvdOpenFile'_ a1' a2' a3' >>= \res ->
toMaybeDVDFile res >>= \res' ->
return (res')
type Size = Word64
size :: File Size
size = File $ StateT
(\f -> liftIO (do s <- withDVDFile f c_DVDFileSize
return (fromIntegral s,f))
)
type Offset = Word32
newtype Status = Status [Size]
deriving (Eq, Read, Show)
toStatus p = do n <- (\ptr -> do {peekByteOff ptr 8 ::IO CInt}) p
q <- (\ptr -> do {peekByteOff ptr 16 ::IO (Ptr CLong)}) p
l <- peekArray (fromIntegral n*2) ((plusPtr p 12)::(Ptr Word32))
return $ Status (map fromIntegral (getEven l))
where getEven [] = []
getEven (x:[]) = []
getEven (x:(y:ys)) = y:(getEven ys)
fileStat :: Title -> ReadDomain -> DVDRead (Maybe Status)
fileStat t d = DVDRead $ StateT
(\s ->
do p <- mallocBytes 88
i <- withDVDReader s (\x ->
c_DVDFileStat x (fromIntegral t) (cFromEnum d) p)
if i == (1)
then do free p
return (Nothing,s)
else do st <- toStatus p
free p
return (Just st,s)
)
blockSize :: Word64
blockSize = 2048
readBlocks :: Offset
-> Size
-> File (Maybe ByteString)
readBlocks off n = File $ StateT
(\f -> DVDRead $ StateT
(\d -> do p <- mallocBytes $ fromEnum (n * blockSize)
s <- withDVDFile f (\x -> c_DVDReadBlocks x (fromIntegral off) (fromIntegral n) p)
if s == (1)
then do free p
return ((Nothing,f),d)
else do q <- reallocBytes p (fromEnum ((fromIntegral s) * blockSize))
b <- unsafePackCStringFinalizer (castPtr q) (fromEnum ((fromIntegral s) * blockSize)) (free q)
return ((Just b,f),d)
)
)
newtype VolumeIdentifier = VolumeID C.ByteString
deriving (Eq, Read, Show)
newtype VolumeSetIdentifier = VolumeSetID C.ByteString
deriving (Eq, Read, Show)
udfVolumeInfo :: DVDRead (Maybe (VolumeIdentifier,VolumeSetIdentifier))
udfVolumeInfo = DVDRead $ StateT
(\s -> do p <- mallocBytes 33
q <- mallocBytes 128
i <- withDVDReader s (\x -> c_DVDUDFVolumeInfo x p 33 (castPtr q) 128)
if i == (1)
then do free p
free q
return (Nothing,s)
else do v <- packCString p
vs <- packCStringLen (q,128)
free p
free q
return (Just (VolumeID v,VolumeSetID vs),s)
)
isoVolumeInfo :: DVDRead (Maybe (VolumeIdentifier,VolumeSetIdentifier))
isoVolumeInfo = DVDRead $ StateT
(\s -> do p <- mallocBytes 33
q <- mallocBytes 128
i <- withDVDReader s (\x -> c_DVDISOVolumeInfo x p 33 (castPtr q) 128)
if i == (1)
then do free p
free q
return (Nothing,s)
else do v <- packCString p
vs <- packCStringLen (q,128)
free p
free q
return (Just (VolumeID v,VolumeSetID vs),s)
)
readBytes :: Offset
-> Size
-> File (Maybe ByteString)
readBytes off n = File $ StateT
(\f -> DVDRead $ StateT
(\d -> do i <- withDVDFile f (\x -> c_DVDFileSeek x (fromIntegral off))
if i == 1
then return ((Nothing,f),d)
else do
p <- mallocBytes $fromEnum n
s <- withDVDFile f (\x -> c_DVDReadBytes x p (fromIntegral n))
if s == (1)
then do free p
return ((Nothing,f),d)
else do b <- packCStringLen (castPtr p, fromIntegral s)
free p
return ((Just b,f),d)
)
)
readVMGInfoFile :: DVDRead ByteString
readVMGInfoFile = readWholeFile 0 InfoFile
readVMGInfoBackupFile :: DVDRead ByteString
readVMGInfoBackupFile = readWholeFile 0 InfoBackupFile
readVMGMenu ::DVDRead ByteString
readVMGMenu = readWholeFile 0 MenuVobs
readVTSInfoFile :: Title -> DVDRead ByteString
readVTSInfoFile t = readWholeFile t InfoFile
readVTSInfoBackupFile :: Title -> DVDRead ByteString
readVTSInfoBackupFile t = readWholeFile t InfoBackupFile
readVTSMenu :: Title -> DVDRead ByteString
readVTSMenu t = readWholeFile t MenuVobs
readWholeFile :: Title -> ReadDomain -> DVDRead ByteString
readWholeFile t d = file t d (do l <- size
if (d == InfoFile) || (d == InfoBackupFile)
then do Just b <- readBytes 0 (l * blockSize)
return b
else do Just b <- readBlocks 0 l
return b
)
foreign import ccall safe "DVD/DVDRead.chs.h DVDOpen"
dvdOpen'_ :: ((Ptr CChar) -> (IO (Ptr (DVDReader))))
foreign import ccall safe "DVD/DVDRead.chs.h DVDUDFCacheLevel"
dvdUDFCacheLevel'_ :: ((Ptr (DVDReader)) -> (CInt -> (IO CInt)))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDDiscID"
c_DVDDiscID :: ((Ptr (DVDReader)) -> ((Ptr CUChar) -> (IO CInt)))
foreign import ccall safe "DVD/DVDRead.chs.h DVDOpenFile"
dvdOpenFile'_ :: ((Ptr (DVDReader)) -> (CInt -> (CInt -> (IO (Ptr (DVDFile))))))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDFileSize"
c_DVDFileSize :: ((Ptr (DVDFile)) -> (IO CLong))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDFileStat"
c_DVDFileStat :: ((Ptr (DVDReader)) -> (CInt -> (CInt -> ((Ptr ()) -> (IO CInt)))))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDReadBlocks"
c_DVDReadBlocks :: ((Ptr (DVDFile)) -> (CInt -> (CULong -> ((Ptr CUChar) -> (IO CLong)))))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDUDFVolumeInfo"
c_DVDUDFVolumeInfo :: ((Ptr (DVDReader)) -> ((Ptr CChar) -> (CUInt -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDISOVolumeInfo"
c_DVDISOVolumeInfo :: ((Ptr (DVDReader)) -> ((Ptr CChar) -> (CUInt -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDFileSeek"
c_DVDFileSeek :: ((Ptr (DVDFile)) -> (CInt -> (IO CInt)))
foreign import ccall unsafe "DVD/DVDRead.chs.h DVDReadBytes"
c_DVDReadBytes :: ((Ptr (DVDFile)) -> ((Ptr ()) -> (CULong -> (IO CLong))))