Skip to content

Instantly share code, notes, and snippets.

@crabtw
Created March 15, 2009 09:14
Show Gist options
  • Save crabtw/79375 to your computer and use it in GitHub Desktop.
Save crabtw/79375 to your computer and use it in GitHub Desktop.
module Main where
import Codec.Text.IConv
import Control.Monad
import Data.Bits
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Time
import Network.Curl
import System.Console.GetOpt
import System.Directory
import System.Environment
import System.Exit
import System.IO
import System.Locale
import System.Process
import Text.Regex.PCRE
-- Supported VCS
data Repository = Git FilePath
deriving (Read, Show)
-- Configuration
data Config = Config {
repository :: Repository
, username :: String
, password :: String
, semester :: String
} deriving (Read, Show)
type Resp = CurlResponse_ [(String, String)] ByteString
defaultConfig = Config {
repository = Git "972"
, username = "s941522"
, password = ""
, semester = "972"
}
-- YZU Portal links
url path = "https://portal.yzu.edu.tw" ++ path
logincheck_new = "/logincheck_new.asp"
login_student_in = "/VC/login_student_in.asp"
classlistsall = "/VC/classlistsall.asp"
myclassmate cid = "/VC/contact/myclassmate.asp?CCN=x&PClass=" ++ cid
mkRegex src = makeRegexOpts compOpt execOpt pat :: Regex
where compOpt = defaultCompOpt .|.
compUTF8 .|. compDotAll .|. compUngreedy
execOpt = defaultExecOpt
pat = B.pack src
conv = convertFuzzy Transliterate "big5" "utf8"
login h uid pwd = do
let info = [CurlPostFields ["uid="++uid, "pwd="++pwd], CurlPost True]
do_curl_ h (url logincheck_new) info :: IO Resp
resp <- do_curl_ h (url login_student_in) method_GET :: IO Resp
return $ match (mkRegex "Login_student\\.asp") $ conv $ respBody resp
listCourses h smtr = do
let opts =
[ CurlPostFields
[ "otherSmtr="++smtr
, "selDepartmentNo=*"
, "selYear=*"
]
, CurlPost True
]
resp <- do_curl_ h (url classlistsall) opts :: IO Resp
return $ parseCourseList $ conv $ respBody resp
parseCourseList page = map (map B.unpack . tail) info
where info = match (mkRegex pat) page
pat = "PClass=(\\d+_(\\w{2})(\\d{3}_\\w+))&"
getClassmates h cid = do
resp <- do_curl_ h (url $ myclassmate cid) method_GET :: IO Resp
return $ format $ parseMates $ conv $ respBody resp
parseMates page = map (dropHead . parseRow) rows
where dropHead row = if B.null $ head row
then drop 8 row
else tail row
parseRow = map last . match (mkRegex pat)
where pat = "<(?:TD|td)>\\s*(\\S*)\\s*</(?:TD|td)>"
rows :: [ByteString]
rows = map last $ match (mkRegex "<tr.*>(.+)</TR>") page
format = B.unlines . map (B.intercalate $ B.pack "\t\t")
-- Options
data Opt = Help
| ConfigFile FilePath
flags =
[ Option ['h'] ["help"] (NoArg Help)
"Print this help message"
, Option ['f'] ["cinfig-file"] (ReqArg ConfigFile "FILE")
"Specify configuration file"
]
getConfigFromOpts = getArgs >>= parseArgs >>=
foldM handleFlag defaultConfig
usageHeader progname = "Usage: " ++ progname ++ " [opts...]"
parseArgs argv = do
progname <- getProgName
case getOpt Permute flags argv of
(opts, _, []) -> return opts
(_, _, errs) -> do
let usage = usageInfo (usageHeader progname) flags
hPutStrLn stderr $ concat errs ++ usage
exitWith $ ExitFailure 1
handleFlag conf opt = do
progname <- getProgName
case opt of
Help -> do
hPutStrLn stderr $ usageInfo (usageHeader progname) flags
exitWith ExitSuccess
ConfigFile f -> liftM read $ readFile f
-- VCS commands
runGitCommand = rawSystem "git"
getTimeStamp = getCurrentTime >>=
return . utcToLocalTime (hoursToTimeZone 8) >>=
return . formatTime defaultTimeLocale "%F %T"
commit (Git _) = do
existed <- doesDirectoryExist ".git"
if existed
then return ExitSuccess
else do
runGitCommand ["init"]
runGitCommand ["add", "."]
time <- getTimeStamp
runGitCommand ["commit", "-a", "-m", time]
return ()
main = do
conf <- getConfigFromOpts
case repository conf of
Git path -> setCurrentDirectory path
h <- initialize
setopts h [CurlCookieJar "/tmp/cookies"]
success <- login h (username conf) (password conf)
if success
then return ()
else do
hPutStrLn stderr "login failed"
exitWith $ ExitFailure 1
courses <- listCourses h $ semester conf
forM_ courses $ \cos -> do
let [cid, dept, id] = cos
putStrLn cid
info <- getClassmates h cid
createDirectoryIfMissing False dept
setCurrentDirectory dept
B.writeFile (id++".txt") info
setCurrentDirectory ".."
commit $ repository conf
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment