Const #LIST_TREE = "feedtree"
Const #FEED_STATUS_NEW = 5
Const #FEED_STATUS_READ = 4
Const #FEED_STATUS_SUCCESS = 1
Const #FEED_STATUS_INTERRUPTED = -2
Const #FEED_STATUS_ERROR = -3
Function p_FillListTree(listtree$, treetable)
mui.Set(listtree$, "Quiet", True)
;č ForEach začíná od 1 a teprve na konci se vrací k 0
;ForEach(treetable, p_InsertNode, listtree$)
For _i, t In IPairs(treetable)
mui.DoMethod(listtree$, "Insert",
t.name, t.id, t.parent, "Tail", IIf(t.isNode, "List", ""))
;č pro jednotlivé položky nelze zadat kontextové menu
;mui.Set(t.id, "ContextMenu", "channeltitlemenu")
Next
mui.Set(listtree$, "Quiet", False)
EndFunction
Function p_DumpFeedTree()
cFeeds = CreateList() ;currentFeeds
p_DumpListTree(#LIST_TREE, cFeeds, "Root", "Root")
Return(cFeeds)
EndFunction
;č tohle musí být rekurzivní
Function p_DumpListTree(listtree$, tabletree, nodeid, muiid)
Local isFound, t = mui.DoMethod(listtree$, "GetEntry", muiid, "Head", "")
While isFound ;And HaveItem(t, "id")
;č tady je možná chyba, kterou nemá cenu hlídat.
;č pokud uživatel docílí toho, že strom vrátí prvek bez id,
;č tak hlídej-nehlídej - program je odsouzen k meditaci
InsertItem(tabletree, {id=t.id, name=t.name, isNode=t.node, parent=nodeid})
If t.Node = True Then p_DumpListTree(listtree$, tabletree, t.id, t.muiid)
isFound, t = mui.DoMethod(listtree$, "GetEntry", t.muiid, "Next", "")
Wend
EndFunction
Function p_FetchAll()
p_Lock()
If IsOnline() Then p_TimeFetch("Root")
p_Unlock()
EndFunction
@IF Not #HW_AROS
Function progress_curl_callback(total, count, utotal, ucount, url$)
Local internets$ = IIF(count > 0, " (" .. count .. "/" .. total ..")", "")
mui.Set("status", "Contents", "Downloading" .. internets$ .. " from " .. url$)
CheckEvents() ; keep MUI responsive
Return(PleaseStop)
EndFunction
Function write_curl_callback(data$, t)
InsertItem(t, data$)
CheckEvents() ; keep MUI responsive
If PleaseStop Then Return(#CURL_WRITEFUNC_PAUSE)
EndFunction
@ENDIF
Function p_TimeFetch(muiid)
Local tid = StartTimer(Nil)
Local e = Nil
If UseDefaultDownloader
p_FetchGroup(muiid, Nil)
Else
e = hurl.Easy()
e:SetOpt_Accept_Encoding("")
;e:SetOpt_AutoReferer(1)
e:SetOpt_ConnectTimeout(3)
e:SetOpt_FileTime(1)
e:SetOpt_FailOnError(1)
e:SetOpt_FollowLocation(1)
e:SetOpt_NoProgress(0)
e:SetOpt_TimeCondition(1) ;#HURL_TIMECOND_IFMODSINCE undefined
e:SetOpt_UserAgent("IvoRSS")
;e:SetOpt_SSL_FalseStart(1)
;e:SetOpt_TCP_FastOpen(1)
p_FetchGroup(muiid, e)
; destroy easy object
e:Close()
EndIf
If PleaseStop
mui.Set("status", "Contents", "job is interrupted")
Else
mui.Set("status", "Contents", "job is done after " ..GetTimer(tid) .." ms")
EndIf
StopTimer(tid)
EndFunction
;č zjistit co je Node zač,
;č podle toho postupovat
Function p_FetchCurrent()
p_Lock()
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", "Active", "Active", "")
If isFound And Not PleaseStop And IsOnline()
If t.Node
p_TimeFetch(t.muiid)
Else
Local status = p_Fetch(t.id, Nil)
CollectGarbage()
If status = #FEED_STATUS_NEW
p_MarkFeed(t.id, #FEED_STATUS_READ)
Ivor:Load(t.id)
ElseIf status = #FEED_STATUS_SUCCESS
p_MarkFeed(t.id, #FEED_STATUS_READ)
Ivor:Load(t.id)
Else
p_MarkFeed(t.id, status)
EndIf
EndIf
EndIf
p_Unlock()
EndFunction
Function p_ShowCurrent()
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", "Active", "Active", "")
If Not isFound Or t.Node Then Return()
If HaveItem(feedsdata, t.id)
If fd_Get(t.id, "status") = #FEED_STATUS_NEW
p_MarkFeed(t.id, #FEED_STATUS_READ)
EndIf
Ivor:Load(t.id)
Else
Ivor:Clear()
EndIf
EndFunction
;č zjistit co je Node zač,
;č podle toho postupovat
;č musí být rekurzivní
Function p_FetchGroup(muiid$, e)
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", muiid$, "Head", "")
While isFound And Not PleaseStop
If t.Node
p_FetchGroup(t.muiid, e)
Else
p_FetchFeed(t.id, e)
EndIf
isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", t.muiid, "Next", "")
Wend
EndFunction
;č označit buď jako nové, nebo jako přečtené
;č smí se posílat JENOM fidy, nikoliv skupiny
Function p_FetchFeed(feedid$, e)
Local status = p_Fetch(feedid$, e)
CollectGarbage()
If status = #FEED_STATUS_SUCCESS
If fd_Get(feedid$, "status") = #FEED_STATUS_NEW Then Return()
status = #FEED_STATUS_READ
EndIf
p_MarkFeed(feedid$, status)
EndFunction
Function p_MarkFeed(feedid$, status)
;č ekonomie na nesprávném místě
;If fd_isEqualOrSet(feedid$, "status", status) Then Return()
fd_Set(feedid$, "status", status)
Local preparse$ = ""
Switch status
Case #FEED_STATUS_NEW:
preparse$ = "\27".."5\27b"
Case #FEED_STATUS_READ:
preparse$ = "\27".."5"
Case #FEED_STATUS_INTERRUPTED:
preparse$ = "\27".."5\27i"
Case #FEED_STATUS_ERROR:
preparse$ = "\27i"
EndSwitch
mui.DoMethod(#LIST_TREE, "Rename", feedid$, preparse$ .. feedid$)
EndFunction
Function p_RemoveCurrent()
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", "Active", "Active", "")
If isFound And mui.Request("Delete ".. IIf(t.Node, "group", "RSS feed"),
"Do you realy want to delete ".. t.Name ..
IIf(t.Node, " \27ngroup and all its content?", "\27n?"),
"Yes|*Cancel", "Warning")
mui.DoMethod(#LIST_TREE, "Remove", "Active", t.id)
;č vyhodit i přidružená data.
;č Hollywood se pak doopravdy tváří, že tu položku nikdy neznal,
;č HaveItem vrací lež no a přístup pak způsobí chybu
feedsdata[LowerStr(t.id)] = nil
;č Na soubory ve složce Feeds sereme?
EndIf
p_SaveFeeds()
EndFunction
Function p_CreateGroup()
Local s$, ok = StringRequest("Create Group", "Enter new group name")
If EmptyStr(s$) Then Return()
s$ = StripStr(s$)
If p_HasItem(s$, "Root")
mui.Set("status", "Contents", "\27bGroup "..s$ .. " already exists")
Else
mui.DoMethod(#LIST_TREE, "Insert", "\27b"..s$, s$, "Root",
IIf(mui.Get(#LIST_TREE, "Active")="Off", "Tail","Active"),
"List; Active")
p_SaveFeeds()
;p_Replay(err_code, "Group ".."\27b"..s$ .. " has been created")
EndIf
EndFunction
Function p_AddFeedRequest()
Local type, data$ = GetClipboard()
Local s$, ok = StringRequest("Add RSS feed", "Enter feed adress",
IIf(type = #CLIPBOARD_TEXT And StartsWith(data$, "http"),
{Text=data$}, {}))
p_AddFeed(s$)
p_SaveFeeds()
EndFunction
Function p_AddFeed(feedid$)
If EmptyStr(feedid$) Then Return()
feedid$ = StripStr(feedid$)
feedid$ = ReplaceStr(feedid$, " ", "%20", True, 0, #ENCODING_RAW)
If p_HasItem(feedid$, "Root")
mui.Set("status", "Contents", feedid$ .. " \27balready exists")
Else
mui.DoMethod(#LIST_TREE, "Insert", feedid$, feedid$, "Root",
IIf(mui.Get(#LIST_TREE, "Active")="Off", "Tail","Active"),
"Active")
EndIf
EndFunction
;č Kurňadrát, RapaGUI takové starosti nemá...
;č jen pro zábavu
Function p_CanHas(nodeid$)
Return(Not p_HasItem(nodeid$, "Root"))
EndFunction
;č tohle musí být rekurzivní
Function p_HasItem(nodeid$, muiid)
nodeid$ = StripStr(nodeid$)
;č mezera zboří serializator
nodeid$ = ReplaceStr(nodeid$, " ", "%20", True, 0, #ENCODING_RAW)
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", muiid, "Head", "")
While isFound
If LowerStr(t.id) = LowerStr(nodeid$) Then Return(True)
If t.Node And p_HasItem(nodeid$, t.muiid) Then Return(True)
isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", t.muiid, "Next", "")
Wend
Return(False)
EndFunction
Function p_SaveFeeds()
Local err_code = ?StringToFile(SerializeTable(
p_DumpFeedTree()), "feeds.json")
p_Replay(err_code, "Feeds saved")
EndFunction
Function p_HideFeeds()
mui.DoMethod(#LIST_TREE, "close", "root", "all")
EndFunction
Function p_ExpandFeeds()
mui.DoMethod(#LIST_TREE, "open", "root", "all")
EndFunction
;č stáhnout soubor
;č možné statusy
/*
#FEED_STATUS_NEW
#FEED_STATUS_SUCCESS
#FEED_STATUS_INTERRUPTED
#FEED_STATUS_ERROR
*/
Function p_Fetch(url$, e)
;č Já se bojím. Co kdyby nějaký server posílal blbosti?
;č Uživatel bude cvakat Fetch a mu jen "Download skipped"?
;
;č objevilo, že TCP handshake je šíleně dlouhá záležitost
;č tohle, jako, skoro dvojnásobně prodlužuje stahování
;č Na druhou stranu, psát v Hollywoodu něco jako kólbeky,
;č které by alokovaly buffery je pěkný nesmysl
If Not isNil(e) ;And timestamp > -1
e:SetOpt_URL(url$)
e:SetOpt_ProgressFunction(progress_curl_callback, url$) ;userdata
Local tdata = CreateList()
e:SetOpt_WriteFunction(write_curl_callback, tdata)
Local servertime = fd_Get(url$, "servertime")
If servertime > 0
e:SetOpt_TimeValue(servertime)
;DebugPrint("servertime", servertime)
ElseIf fd_Get(url$, "localtime") > 0
e:SetOpt_TimeValue(fd_Get(url$, "localtime"))
;DebugPrint("localtime", fd_Get(url$, "localtime"))
Else
e:UnsetOpt_TimeValue()
;DebugPrint("Nothing time")
EndIf
;e:SetOpt_Nobody(1)
Local err_code = ?e:Perform()
If err_code <> #ERR_NONE
If PleaseStop
;mui.Set("status", "Contents", "interrupted")
Return(#FEED_STATUS_INTERRUPTED)
Else
;č přece je nějaká chyba
mui.Set("status", "Contents", "\27b" .. GetErrorName(err_code))
Return(#FEED_STATUS_ERROR)
EndIf
ElseIf e:GetInfo_Condition_Unmet()
mui.Set("status", "Contents", GetErrorName(err_code)
.." (skip downloading from " ..url$ ..")")
;č Soubor na serveru se nezměnil
;č neděláme nic, vracíme úspěch
;DebugPrint("skipped", url$)
Return(#FEED_STATUS_SUCCESS)
EndIf
;č úspěch
;DebugPrint(e:GetInfo_FileTime())
Return(p_LookThrough(url$, Concat(tdata), e:GetInfo_FileTime()))
EndIf
;
; Default downloader
;
;č zjednodušená kontrola, pokud řetězec obsahuje procenta,
;č považujeme ho za "eskejpnutý".
;č Na případ, kdy uživatel strčí do URLu osamělý znak procenta vysereme
Local err_code, xml$, count = ?DownloadFile(url$,
{Adapter=#HTTP_ADAPTER, Fail404=True,
Encoded=FindStr(url$, "%", True) <> -1}, p_callback, url$)
p_Replay(err_code, count .. " bytes from " .. url$ .. " transmitted")
CheckEvents() ; keep MUI even more responsive
If err_code <> #ERR_NONE Then Return(#FEED_STATUS_ERROR)
If PleaseStop Then Return(#FEED_STATUS_INTERRUPTED)
;č není chyba? Tam posíláme dál
Return(p_LookThrough(url$, xml$))
EndFunction
Function p_LookThrough(url$, xml$, servertime)
Local checksum = CRC32Str(xml$)
If fd_Get(url$, "checksum") = checksum Then Return(#FEED_STATUS_SUCCESS)
Local err_code = ?StringToFile(xml$, p_GetXMLname(url$))
p_Replay(err_code, "Updated XML file from " ..url$ .." saved")
If err_code <> #ERR_NONE Then Return(#FEED_STATUS_ERROR)
fd_Set(url$, "checksum", checksum)
fd_Set(url$, "servertime", servertime)
fd_Set(url$, "localtime", GetTimestamp(#TIMESTAMP_UNIX))
;č kolikrát weby dodají do RSS nějaký BuildDate,
;č kterým se RSS formálně změní.
;č Takže zde, na místě, když ještě máme xml v ruce,
;č musíme rozhodnout, zda je v tom RSS doopravdy něco nového.
;č Objevilo se, že kolikrát ty kanály žádné guid nemají,
;č specifikace RSS totiž ustanovuje povinným pouze buď title,
;č nebo description.
;č Některé kanály navíc neumísťují nejnovější články na první místo.
;č Napadlo mně, že by bylo možné počítat kontrolní sumu od prvního item
;č až do konce souboru. Tím
;č 1. odřízneme veškeré BuildDate kanálu atd.
;č 2. zachytíme změny článků,
;č a) aniž by byly na prvním místě
;č b) aniž bychom celý obsah parsili a hlídali
;č nové příspěvky ve slovnících.
;
;č nechcu to posílat do další funkce
;č Já totiž nejsem 100% jist, že Hollywood ty řetězce nekopíruje
Local guidsum = 0
;č Kódování nemusíme řešit, je to jen pro nás,
;č žádný parser zde volat nebudeme.
Local guidpos = Max(FindStr(xml$, "<entry", False, 0, #ENCODING_RAW),
FindStr(xml$, "<item", False, 0, #ENCODING_RAW))
;č XML-ko je nové, ale kanál neobsahuje nic?
;č Tak já nevím...
If guidpos < 0
mui.Set("status", "Contents", "\27".."5\27i ".. url$ .. " is empty")
Return(#FEED_STATUS_SUCCESS)
EndIf
guidsum = CRC32Str(UnrightStr(xml$, guidpos, #ENCODING_RAW))
If fd_isEqualOrSet(url$, "guidsum", guidsum)
Return(#FEED_STATUS_SUCCESS)
EndIf
DebugPrint(url$, guidsum)
mui.Set("status", "Contents", "\27".."5\27b" .. url$ .. " Updated!")
Return(#FEED_STATUS_NEW)
EndFunction
Function p_CopyTreeURL()
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", "Active", "Active", "")
If isFound
err_code = ?SetClipboard(#CLIPBOARD_TEXT, t.id)
p_Replay(err_code, "Copied!")
EndIf
EndFunction
Function p_ShowSource()
Local isFound, t = mui.DoMethod(#LIST_TREE, "GetEntry", "Active", "Active", "")
If Not isFound Or t.Node Then Return()
;SendRexxCommand("MULTIVIEW.1", "OPEN" .. CanonizePath(p_GetXMLname(t.id)))
Run("Sys:Utilities/Multiview", CanonizePath(p_GetXMLname(t.id)))
EndFunction