/feedtree.hws (5d5e42c17a06d36208115778a13998d6c7a22d84) (13204 bytes) (mode 100755) (type blob)


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


Mode Type Size Ref File
100755 blob 6407 e72a76d6b87c502f01cb106825d3faf3176883d3 AppWindow.xml
100755 blob 8938 222f6ab47ea55ef359df8b59f15bff1b47d1876d IvoR.hws
100755 blob 9409 924c086890226fa30343f3464fba31c7e4cbbb87 IvoRSS.hws
100755 blob 1093 263306d87c51114b1320be2ee3277ea0bff99b1f LICENSE
100755 blob 3064 97f474b5028df48f4d11a448ac01abc9fb11a00b ReadMe
100755 blob 4055 b99bd5bded6a665cc292d0774c58dbc4ac60ddd3 feeds.hws
100755 blob 1694 83e47eb86860331dfe771f49029c00559a2f687e feedsdata.hws
100755 blob 13204 5d5e42c17a06d36208115778a13998d6c7a22d84 feedtree.hws
040000 tree - 7be1150404eabeaa6a719b670e11826856e148e5 icons
100755 blob 7312 3608e21fca8793013d5273cd5a692f1a41825b65 lurk.hws
100755 blob 10998 28e795e1a81dfb2c263fe9d0235665da33facc45 textfield.hws
Hints:
Before first commit, do not forget to setup your git environment:
git config --global user.name "your_name_here"
git config --global user.email "your@email_here"

Clone this repository using HTTP(S):
git clone https://rocketgit.com/user/iam-git/IvoRSS

Clone this repository using ssh (do not forget to upload a key first):
git clone ssh://rocketgit@ssh.rocketgit.com/user/iam-git/IvoRSS

Clone this repository using git:
git clone git://git.rocketgit.com/user/iam-git/IvoRSS

You are allowed to anonymously push to this repository.
This means that your pushed commits will automatically be transformed into a merge request:
... clone the repository ...
... make some changes and some commits ...
git push origin main