pgdl 6.9 → 7.0
raw patch · 12 files changed
+121/−57 lines, 12 filesdep +HTTP
Dependencies added: HTTP
Files
- README.md +5/−3
- pgdl.cabal +8/−6
- src/Beaut.hs +2/−3
- src/Chkcfg.hs +9/−9
- src/FetchHtml.hs +3/−1
- src/GenName.hs +10/−0
- src/GenStat.hs +11/−10
- src/Log.hs +2/−12
- src/Main.hs +4/−2
- src/PlayVid.hs +5/−2
- src/PrsVid.hs +29/−9
- src/SortVid.hs +33/−0
README.md view
@@ -1,7 +1,9 @@ # pgdl-a terminal user interface program that downloads a video from html and plays immediately.(Calling vlc) -Only for Linux and MACOSX.+a terminal user interface program that downloads a video from html and call vlc to play it immediately. -It parses a remote html file which has link tag & filename tag in the same line.+Client: Only for Linux and MACOSX.+Server: Only for nginx's file download page.+ +The program will sort the files by date while the files in nginx's download page just show in file names' order.
pgdl.cabal view
@@ -1,6 +1,6 @@ name: pgdl-version: 6.9+version: 7.0 license: PublicDomain license-file: LICENSE author: sifmelcara@@ -9,12 +9,13 @@ build-type: Simple extra-source-files: README.md cabal-version: >=1.10-description: a terminal user interface program that downloads a video from html and plays immediately.(Calling vlc)+description: a terminal user interface program that downloads a video from html and call vlc to play it immediately. .- Only for Linux and MACOSX.+ Client: Only for Linux and MACOSX. .- It parses a remote html file which has link tag & filename tag in the same line.+ Server: Only for nginx's file download page. .+ The program will sort the files by date while files in nginx's download page just sort in file name. synopsis: pgdownloader source-repository head@@ -24,12 +25,13 @@ executable pgdl hs-source-dirs: src main-is: Main.hs- other-modules: Beaut, Chkcfg, FetchHtml, Getconfig, Log, PlayVid, PrsVid, Search, Video, GenStat, TestExist + other-modules: Beaut, Chkcfg, FetchHtml, Getconfig, Log, PlayVid, PrsVid, Search, Video, GenStat, TestExist,+ GenName, SortVid build-depends: base == 4.* , split, process, directory, http-conduit >= 2.0.0, bytestring, transformers, resourcet, tagsoup, vty, text, vty-ui >= 1.8,- configurator >= 0.3.0.0,+ configurator >= 0.3.0.0, HTTP, filepath, binary >= 0.7.0.0, Cabal ghc-options: -threaded -O2 default-language: Haskell2010
src/Beaut.hs view
@@ -8,14 +8,13 @@ import qualified Data.Text as T beaut :: Video -> T.Text-beaut vid+beaut (Video str _ _ _) | length dat < 3 = "\n" `app` str | otherwise = T.intercalate "\n" [tb 4 `app` sbt, tb 10 `app` nme, tb 30 `app` eps ]- where str = vidName vid- dat = spl str+ where dat = spl str (sbt:nme:eps:_) = dat tb n = T.replicate n " " app s1 s2 = s1 `T.append` s2
src/Chkcfg.hs view
@@ -13,16 +13,16 @@ error "please config file at ~/.pgdl first!" defcfg = unlines [ "",- "# example:",- "# username = \"jack\"",- "# password = \"mypassw\"",- "# servpath = \"example.org/videodir/?C=M;O=D\"",- "# localdir = \"/home/jack/Downloads/\"", + "# example: ",+ "# username = \"jack\" ",+ "# password = \"mypassw\" ",+ "# servpath = \"example.org/videodir/\" ",+ "# localdir = \"/home/jack/Downloads/\" ", "",- "username = ",- "password = ",- "servpath = ",- "localdir = ",+ "username = \"\"",+ "password = \"\"",+ "servpath = \"\"",+ "localdir = \"\"", "" ]
src/FetchHtml.hs view
@@ -18,7 +18,9 @@ username <- getUsername password <- getPassword servpath <- getServpath- return $ applyBasicAuth (tob username) (tob password) . fromJust . parseUrl $ "http://" ++ T.unpack servpath+ case username of+ "" -> return $ fromJust . parseUrl $ "http://" ++ T.unpack servpath+ _ -> return $ applyBasicAuth (tob username) (tob password) . fromJust . parseUrl $ "http://" ++ T.unpack servpath where tob = encodeUtf8 fetchHtml :: IO T.Text
+ src/GenName.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}++module GenName where++import Network.HTTP.Base+import qualified Data.Text as T++genName :: T.Text -> T.Text+genName = T.pack . urlDecode . T.unpack+
src/GenStat.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} -module GenStat (genStat) where+module GenStat (genStat, waitingBar) where import Video import TestExist@@ -9,21 +9,22 @@ import qualified Data.Text as T genStat :: Video -> IO T.Text-genStat vid = do+genStat (Video name _ size date) = do st <- toStr $ downloaded name- return $ (spc 3) `app` date `app`- (spc 3) `app` size `app`- (spc 20) `app` st `app`- (spc 30)- where date = vidDate vid- size = vidSize vid- name = vidName vid- app = T.append+ return $ T.concat [ spc 3 , date+ , spc 5 , size+ , spc 20, st+ , spc 30+ ]+ where app = T.append spc :: Int -> T.Text spc i = T.replicate i " " +waitingBar = " Waiting for data..." `T.append` T.replicate 99 " "+ toStr :: IO Bool -> IO T.Text toStr b = b >>= \case True -> return "Downloaded" _ -> return "Not Downloaded"+
src/Log.hs view
@@ -22,12 +22,7 @@ instance Binary Video where put vid = put $ vidName vid- get = get >>= (\name ->- return Video { vidName = name- , vidLink = ""- , vidDate = ""- , vidSize = ""- })+ get = get >>= \name -> return $ Video name "" "" "" logname = ".pgdl.cache" @@ -48,10 +43,5 @@ Right (_, _, vs) -> return vs _ -> return dlnVid False -> return dlnVid- where dlnVid = [Video { vidName = "Downloading..."- , vidLink = ""- , vidDate = ""- , vidSize = ""- }- ]+ where dlnVid = [Video "Downloading..." "" "" ""]
src/Main.hs view
@@ -37,7 +37,7 @@ lfg <- newFocusGroup addToFocusGroup lfg lst - statBar <- plainText ""+ statBar <- plainText waitingBar setNormalAttribute statBar (black `on` green) ui <- centered =<< hFixed 80 =<< vBox lst statBar@@ -107,7 +107,9 @@ return True _ -> return False - forkIO $ writeVid vdlst+ (null <$> getArgs) >>= \case+ True -> void . forkIO $ writeVid vdlst+ _ -> return () return () return ()
src/PlayVid.hs view
@@ -26,8 +26,11 @@ when fex $ removeFile localloc let purepath = reverse . dropWhile (/= '/') . reverse $ servpath- let url = "http://" ++ username ++ ":" ++ password ++ "@" ++ purepath ++ vu- runCommand $ "nohup curl " ++ addq url ++ " -o " ++ addq localloc ++ "&>/dev/null &"+ case username of+ "" -> let url = "http://" ++ purepath ++ vu+ in runCommand $ "nohup curl " ++ addq url ++ " -o " ++ addq localloc ++ "&>/dev/null &"+ _ -> let url = "http://" ++ username ++ ":" ++ password ++ "@" ++ purepath ++ vu+ in runCommand $ "nohup curl " ++ addq url ++ " -o " ++ addq localloc ++ "&>/dev/null &" let checkFile = doesFileExist localloc >>= \ready -> unless ready checkFile checkFile case buildOS of
src/PrsVid.hs view
@@ -3,6 +3,8 @@ module PrsVid where import Video+import GenName+import SortVid import Data.List import Data.Function@@ -10,7 +12,29 @@ import qualified Data.Text as T prsVid :: T.Text -> [Video]-prsVid = map (genVidInf . filter (not. T.null) . map getInf) .+prsVid = sortVid .+ map (genVid . filter (not . T.null) . map pullText) .+ filter isVidLn . map parseTags . T.lines+ where isVidLn = any isVidLnk+ isVidLnk tg+ | isTagOpen tg = any (`T.isSuffixOf` fromAttrib "href" tg) fmts+ | otherwise = False+ pullText tg+ | isTagOpen tg = fromAttrib "href" tg+ | isTagText tg = fromTagText tg+ | otherwise = ""+ genVid [lnk, _, tx] = Video {vidLink = lnk, vidName = nm, vidDate = dt, vidSize = sz}+ where dt = T.intercalate " " . take 2 $ T.words tx+ sz = T.pack . hsz . read . last . words . T.unpack $ tx+ hsz :: Int -> String+ hsz i = show (i `div` (1024*1024)) ++ "M"+ nm = genName lnk+ genVid _ = Video "Parse Fail" "" "" ""+ fmts = [".mp4", ".avi", ".mkv"]+++{-+ map (genVidInf . filter (not. T.null) . map getInf) . filter isVideoLine . map parseTags . T.lines where isVideoLine = any isNameTag@@ -20,22 +44,18 @@ isLinkTag tg | isTagOpen tg = not. T.null $ fromAttrib "href" tg | otherwise = False- isSizeTag tg- | isTagText tg = any (`T.isSuffixOf` fromTagText tg) ["K", "M", "G"]- | otherwise = False- isDateTag tg+ isDtSzTag tg | isTagText tg = all (`T.isInfixOf` fromTagText tg) ["-", ":"] | otherwise = False getInf tg | isNameTag tg = fromTagText tg | isLinkTag tg = fromAttrib "href" tg- | isSizeTag tg = fromTagText tg- | isDateTag tg = fromTagText tg+ | isDtSzTag tg = $ fromTagText tg | otherwise = "" genVidInf [lnk, nm, dt, sz] = Video {vidLink = lnk, vidName = nm, vidDate = dt, vidSize = sz} - getVidInf _ = Video {vidLink = T.empty, vidName = "parse error", vidDate = "", vidSize = ""}+ genVidInf _ = Video {vidLink = T.empty, vidName = "parse error", vidDate = "", vidSize = ""} vdfmt = [".avi", ".mp4", ".mkv"] -+-}
+ src/SortVid.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module SortVid (sortVid) where++import Video++import qualified Data.Text as T+import Data.List+import Data.Function++sortVid :: [Video] -> [Video]+sortVid = sortBy (cmpDate `on` vidDate)++cmpDate :: T.Text -> T.Text -> Ordering+cmpDate = flip compare `on` prs+ where prs tx = [year, tranMon mon, day, time] + where [day, mon, year, time] = concat . map (T.splitOn "-") . (T.splitOn " ") $ tx+ +tranMon :: T.Text -> T.Text+tranMon m = case m of+ "Jan" -> "A"+ "Feb" -> "B"+ "Mar" -> "C"+ "Apr" -> "D"+ "May" -> "E"+ "Jun" -> "F"+ "Jul" -> "G"+ "Aug" -> "H"+ "Sep" -> "I"+ "Oct" -> "J"+ "Nov" -> "K"+ "Dec" -> "L"+