Add URLs automatically in Tversity

Hi,

I like to see a lot of shows that are published on the Internet on a regularly basis but the website does not provide a asx or generic URLs that is automatically updated with the last version of the show. But in general these links have Keep the same format and only change the date based on their last diffusion.

So I developped a small VBscript that Add automatically (I scheduled it to run at the boot of my system and every 2 hours) these shows to my Tversity media server.

I provide this script as-is and will not provide any support on that but if you have question post a message under that subject and I will take a look a it when I have time.

Please Note that The cut&past in this forum removed all the indentation of the script and XML file that make more difficult to read them but it should not cause any issue when comes time to run the script

This is an example of the XML file to use

<?xml version="1.0" encoding="UTF-8"?> http://www.m6.fr/content/video/info/asx/Lyon_00_|2d||2m||2y|.asx M6 Lyon - |4y||2m||2d| Emissions.JT Yes Video URL Monday 2006-12-18 Tuesday 2006-12-19 Wednesday 2006-12-20 Thursday 2006-12-21 Friday 2006-12-22 Saturday Sunday http://www.m6.fr/content/video/info/asx/Bordeaux_00_|2d||2m||2y|.asx M6 Bordeaux - |4y||2m||2d| Emissions.JT Yes Video URL Monday 2006-12-18 Tuesday 2006-12-19 Wednesday 2006-12-20 Thursday 2006-12-21 Friday 2006-12-22 Saturday Sunday

This is the script Listing (to be copied on a file with an vbs extension)
'*******************************************************************************
'*** Author : Ced
'*** Created : 15/12/2006
'*** Last Modified : 16/12/2006
'*** Version : 1.0
'*** Description : This script Update automatically Tversity Media with the URL of weekly shows
'*** Argument(s) : N/A
'*** Input File(s) : An XML file named CONST_INPUTXMLFILEPATH that contains the details about the URL to create
'*** Output file(s) : Log file (scriptName.log) - Contains script execution details
'*** URL file (scriptname-URLs.txt) - Contains a list of all URL added by the script to the Tversity Media server
'*** Remarks : A example of XML file is provided with this script. If the input XML file is not correctly formatted the script rename it
'*** and Create a new template one.
'*** Warning: the XML tags are case sensitive.
'***
'*** URL and Title Tags in the Input file accept the following macros in their string:
'*** |4y| -> replaced by the year on 4 positions (eg: 2006)
'*** |2y| -> replaced by the year on 2 positions (eg: 06)
'*** |2m| -> replaced by the month on 2 positions (eg: 01)
'*** |1m| -> replaced by the month on 1 position (eg: 1)
'*** |2d| -> replaced by the day on 2 positions (eg: 02)
'*** |1d| -> replaced by the day on 1 position (eg: 2)
'***
'*** Note: As Tversity does not accept two URLs with the same Title, it’s important
'*** To add Date macros in the Title string
'***
'*** Note2: Keep the LastUpdated field empty when you create a new schedule, the script will fill it automatically
'*** The first time it will run
'***
'*******************************************************************************

'*** Version 1.0: Initial Release

'*** Script Options
OPTION EXPLICIT

'*** Script Constants - TO BE CUSTOMIZED AS REQUIRED
Const CONST_INPUTXMLFILEPATH = “TversityAutoUpdate-Input.xml” '*** This is the path of the XML file containing URL information
Const CONST_TVERSITYPATH = “D:\Program Files\TVersity\Media Server” '*** Tversity path where the MSHARE Tool is installed. Do not forget to finish with \
Const CONST_SUCCESS_STRING = “added/updated” '*** This string is used to analyse output of the Mshare command and determine if command succeeded or not

'*** Global Variables Declaration
'Add your global variable declaration here
Dim gDEBUG '** BOOLEAN 0=DEBUG DEACTIVATED 1=DEBUG ACTIVATED
Dim gobjFso '** FILESYSTEM OBJECT Object file system use for all files operation
Dim gFirstDayofTheWeek

'*** Global Variables Initialization
gDEBUG = 0
gFirstDayofTheWeek=vbMonday

'*** Script Entry point
main

'***************************************
'*** Procedures and functions
'***************************************

sub main ()
'*****************************************************
'*** Main procedure - Entry point of the script
'*** (Keep this procedure as small as possible)
'*****************************************************

If (gDEBUG=0) Then On Error Resume Next

'*** Create an instance of Filesystem object
Set gobjFso=CreateObject("Scripting.FileSystemObject")


Call WriteLog("INFO;Script started")

'*** Verify if XML file exist and its correct, create if required.
If CheckXMLFile(CONST_INPUTXMLFILEPATH)=True then
 	ParseMediaInfo
End if

Call WriteLog("INFO;Script Ended")

End Sub

Function ParseMediaInfo()
'*****************************************************
'*** Purpose: This procedure Read the Input XML file to get the URL Information
'*** Inputs :
'*** Returns:
'***
'*****************************************************

If (gDEBUG=0) Then On Error Resume Next


Dim objXMLDoc			'*** XMLDOC	Document Object corresponding to the STATE FILE
Dim objrootElement		'*** XMLELEMENT	Get the root element of the XML document
Dim objNode			'*** XMLNODE	Node Object corresponding to one MediaURL

if (gDEBUG=1) then WriteLog "DEBUG; ParseMediaInfo;XML File treated: " &amp; CONST_INPUTXMLFILEPATH	

'*** Load XML File in Memory
set objXMLDoc=CreateObject("Microsoft.XMLDOM")
objXMLDoc.async="false"
objXMLDoc.load(CONST_INPUTXMLFILEPATH)


'*** Test if XML file could be read properly
if objXMLDoc.parseError.ErrorCode <> 0 then
	'*** Error during reading of the XML Document
	Call WriteLog("ERROR;' ParseMediaInfo' for '" &amp; strVMPath &amp; "'Could not load '" &amp; CONST_INPUTXMLFILEPATH &amp; "' Properly. Error " &amp; ObjXMLDoc.ParseError.Reason)
	'**** -----> ParseMediaInfo = 4
Else
	'*** XML Document has been read correctly
	set objrootElement = objXMLDoc.documentElement
	For each objNode in objRootElement.SelectNodes("MediaUrl")
		TreatNode(objNode)
	Next

End if

'*** Release objects...
set objXMLDOC = Nothing
set objNode = Nothing

End Function

Function TreatNode(objNode)
'*****************************************************
'*** Purpose: This procedure Update Tversity with the Right Information using the external command Mshare
'*** Inputs : objNode (XMLNODE Object) - Correspond to one node MediaURL
'*** Returns: True if success, False if failure
'*****************************************************

If (gDEBUG=0) Then On Error Resume Next

Dim objSchedule		'*** XMLNODE	Get the Schedule part of the Media
Dim strTitle		'*** STRING	Title of the Media URL
Dim strURL		'*** STRING	URL of the Media
Dim strURLType		'*** STRING	Type of URL (Video URL, Audio URL, etc.)
Dim strTags		'*** STRING	Tveristy Tags of the Media URL
Dim strPublic		'*** STRING	Public Flag (yes or no)
Dim strWeekDay		'*** STRING	WeekDay use to retrieve the date of the last URL update
Dim strLastUpdated	'*** STRING	Date of the last URL update
Dim dtLastDate		'*** DATE	Get the date of the last time the MediaURl is supposed to be updated

For each objSchedule in objNode.SelectNodes("Schedule")

	'*** Assign Variables from XML value
	strTitle = Objnode.getElementsByTagName("Title").Item(0).text
	strTags = objNode.GetElementsByTagName("Tags").Item(0).Text
	strURL = Objnode.getElementsByTagName("Url").Item(0).text
	strURLType = Objnode.getElementsByTagName("Type").Item(0).text
	strPublic = Objnode.getElementsByTagName("Public").Item(0).text
	strWeekDay = objSchedule.GetElementsByTagName("WeekDay").Item(0).Text
	strLastUpdated = objSchedule.GetElementsByTagName("LastUpdated").Item(0).Text
	if (gDEBUG>=1) then Call WriteLog("DEBUG;" &amp; strTitle &amp; chr(10) &amp; strTags &amp; chr(10) &amp; strURL &amp; chr(10) &amp; strUrlType &amp; chr(10) &amp; strPublic &amp; chr(10) &amp; strWeekDay &amp; chr(10) &amp; strLastUpdated)

	dtLastDate = GetDateLastDayoftheWeek(strWeekDay)
	if dtLastDate=False then
		'**** Error getting the Last date
		Call WriteLog("WARNING;'" &amp; strTitle &amp; "-" &amp; strWeekDay &amp; "' is skipped.")
	Else
		'**** Last date retrieved successfully --> update Tversity media library

		'*** if strLastUpdate is a Null string assign the default date
		If strLastUpdated="" then strLastUpdated="1901-01-01"

		If DateDiff("d", Cdate(strLastUpdated), Cdate(dtLastDate))>0 Then
			'*** Tversity has to be updated
			if (gDEBUG>=1) then Call WriteLog("DEBUG;'" &amp; strTitle &amp; "-" &amp; strWeekDay &amp; "' Has to be updated!")
			If CreateMediaUrl(strTitle,strTags,strUrl,strURLType,strPublic,dtLastDate)=True then
				'*** Update succeeded. Update the XML document
				objSchedule.GetElementsByTagName("LastUpdated").Item(0).Text = dtLastDate
				objSchedule.ownerDocument.save(CONST_INPUTXMLFILEPATH)				
			Else
				'*** Update failed
			End if
		Else
			'*** Tversity already has the last update
			if (gDEBUG>=1) then Call WriteLog("DEBUG;'" &amp; strTitle &amp; "-" &amp; strWeekDay &amp; "' is up to date!")
		End if
		
	End if

Next

'*** Release objects
set objSchedule = Nothing

End function

Function CreateMediaURL(ByVal strTitle, ByVal strTags, ByVal strURL, byVal strURLType, ByVal strPublic, ByVal dtLastDate)
'*****************************************************
'*** Purpose: This Function Use tveristy command line tool to update the tveristy database with the new MediaURL
'*** Inputs : All arguments are used to create the media URL in Tversity
'*** Returns: Return True if success. False if failure
'*****************************************************

dim objShell		'*** WSH SHELL	Shell object used to run the external command
dim strCommand		'*** STRING	Command to execute
dim objShellExec
dim intRunReturn	'*** INTEGER	Return code return by the program executed by the Run command
dim strCmdOutput	'*** STRING	Get the command return

set objShell = WScript.CreateObject("WScript.Shell")

'*** Replace the Title with the Right Date information
strTiTle = ReplaceMacros(strTitle,dtLastDate)

'*** Replace the URL with the Right Date information
strURL = ReplaceMacros(strURL,dtLastDate)

'*** Set the strURLType to be recognised by the Command mShare
Select Case UCASE(strURLType)
	Case "VIDEO URL", "VIDEO"
		strURLType = " -V "
	Case "AUDIO URL", "AUDIO"
		strURLType = " -A "
End Select

strCommand = "%comspec% /c Pushd " &amp; chr(34) &amp; CONST_TVERSITYPATH &amp; chr(34) &amp; " &amp; Mshare -T " &amp; chr(34) &amp; strTitle &amp; chr(34) &amp; " -G " &amp; chr(34) &amp; strTags &amp; chr(34) &amp; strURLType &amp; chr(34) &amp; strURL
if (gDEBUG>=1) then Call WriteLog("DEBUG;strCommand is '" &amp; strCommand &amp; "'")
set objShellExec = objShell.Exec(strCommand)
Do While objShellExec.Status = 0
	WScript.Sleep 100
Loop

strCmdoutput = "out:2" &amp; objShellExec.stdout.ReadAll &amp; "Err:" &amp; objShellExec.stdErr.Readall	
if instr(Ucase(strCmdOutPut), Ucase(CONST_SUCCESS_STRING)) then
	'*** Update Successful
	if (gDEBUG>=1) then Call WriteLog("INFO;Update successful. " &amp; Replace(strCmdOutPut,chr(10),"\

"))
Call WriteURL(strURL)
CreateMediaURL=True
Else
'*** Update failure
Call WriteLog(“ERROR;Update failure. " & Replace(strCmdOutPut,chr(10),”
"))
CreateMediaURL=False
End if

'*** Release object
set objShell = Nothing
set objShellExec = Nothing

End Function

Function ReplaceMacros(strText, dtDate)
'*****************************************************
'*** Purpose: This Function Replace the macro in strText with their values
'*** Inputs : strText - String of text that contains the macro to be replaced
'*** dtDate - Date used to get the current value of the Macros
'*** Returns: Return a string where the macros has been replaced by their value
'*****************************************************

Dim strTextUpdated		'*** STRING with the text updated by the macros

strTextUpdated = strText

'*** Replace year tags
strTextUpdated = Replace(strTextUpdated,"|4y|",year(dtDate))
strTextUpdated = Replace(strTextUpdated,"|2y|",Right(Year(dtDate),2))

'*** Replace Month tags
if Left(Month(dtDate),1)="0" or Len(Month(dtDate))=1 then
	'*** Month number start by 0 (eg: January->01) or is only 1 position length (eg: January->1)
	strTextUpdated = Replace(strTextUpdated,"|1m|",Right(Month(dtDate),1)) '*** Remove leading 0
	strTextUpdated = Replace(strTextupdated,"|2m|","0" &amp; Month(dtDate))    '*** Add leading 0
Else
	strTextUpdated = Replace(strTextUpdated,"|1m|",Month(dtDate))
	strTextUpdated = Replace(strTextupdated,"|2m|",Month(dtDate))
End if 

'*** Replace Day tags
if Left(Day(dtDate),1)="0" or Len(Day(dtDate))=1 then
	'*** Day number start by 0 (eg: 01) or is only 1 position length (1)
	strTextUpdated = Replace(strTextUpdated,"|1d|",Right(Day(dtDate),1)) '*** Remove leading 0
	strTextUpdated = Replace(strTextupdated,"|2d|","0" &amp; Day(dtDate))    '*** Add leading 0
Else
	strTextUpdated = Replace(strTextUpdated,"|1d|",Day(dtDate))
	strTextUpdated = Replace(strTextupdated,"|2d|",Day(dtDate))
End if 

ReplaceMacros = strTextUpdated

End Function

Function GetDateLastDayoftheWeek(strWeekDay)
'*****************************************************
'*** Purpose: This Function return the Date of the Last day of week (eg: Last monday)
'*** Inputs : strWeekDay => week day for which we want to get the last date (monday, Tuesday, Wednesday=3)
'*** Returns: If strweekDay is valide–> DateSerial of the day else return False
'*****************************************************

Dim intDayNumber	'*** INTEGER	Day number corresponding at strWeekDay
Dim intDayNumberNow	'*** INTEGER	Get the weekday of today
Dim intDayDelta		'*** INTEGER	Number of day between now and the date

'*** Get the Day number of strWeekDay
Select Case lcase(strWeekDay)
	Case "monday","lundi"
		intDayNumber = 1
	Case "tuesday","mardi"
		intDayNumber = 2
	Case "wednesday","mercredi"
		intDayNumber = 3
	case "thursday","jeudi"
		intDayNumber = 4
	Case "friday","vendredi"
		intDayNumber = 5
	Case "saturday","samedi"
		intDayNumber = 6
	Case "sunday","dimanche"
		intDayNumber = 7
	Case Else
		Call WriteLog("ERROR;'" &amp; strWeekDay &amp; "' is not a day with a valid name.")
		GetDateLastDayofTheWeek=False
End Select

'*** Get the day number of today
intDayNumberNow=WeekDay(Now,gFirstDayofTheWeek)

intDayDelta = intDayNumberNow - intDayNumber
if intDayDelta>=0 then
	GetDateLastDayofTheWeek = DateSerial(year(Now), month(Now), day(Now)-intDayDelta)
Else
	GetDateLastDayofTheWeek = DateSerial(year(Now), month(Now), day(Now)-(7+intDayDelta))
End if

if (gDEBUG>=1) then Call WriteLog("DEBUG;dtLastDate for '" &amp; strWeekDay &amp; "(" &amp; intDayNumber &amp; ") is '" &amp; GetDateLastDayofTheWeek &amp; "'")

End Function

Function CheckXMLFile(strXMLFilePath)
'*****************************************************
'*** Purpose: This procedure Verify if the XML file exist and his in good shape. in the file system and create it if required.
'*** Inputs : Path of the XML file to test
'*** Returns: True if success, False if failure
'*****************************************************

If (gDEBUG=0) Then On Error Resume Next

Dim strXMLFilePathCopy		'*** STRING		Path of copy of the XML file in case of we have to rebuild it.
Dim objXMLDoc			'*** XML OBJECT		Document Object corresponding to the STATE FILE

'*** instantiate XMLDoc Object
set objXMLDoc=CreateObject("Microsoft.XMLDOM")


If (gobjFSO.FileExists(strXMLFilePath)) Then
	'*** File Exist, test if it's a Good XML File
	'*** Load XML File in Memory
	objXMLDoc.async="false"
	objXMLDoc.load(strXMLFilePath)

	'*** Test if XML file could be read properly
	if objXMLDoc.parseError.ErrorCode <> 0 then
		'*** Error during reading of the XML Document
		Call WriteLog("ERROR;'CheckXMLFile' Could not load '" &amp; strXMLFilePath &amp; "' Properly. Error " &amp; ObjXMLDoc.ParseError.Reason)
	
		'*** Delete the File and recreate a New one.
		strXMLFilePathCopy = strXMLFilePath &amp; " - File not correct - "
		Call gobjFso.CopyFile(strXMLFilePath, strXMLFilePathCopy, true)
		if Err.Number <> 0 then
			'*** Error Copying file
			Call WriteLog("WARNING;Error during copy of '" &amp; strXMLFilePath &amp; "' to '" &amp; strXMLFilePathCopy &amp; "'. Error: " &amp; Err.Description)
		End if

		'*** Delete Current XML File
		Call gobjFso.DeleteFile(strXMLFilePath)
		if Err.Number <> 0 then
			'*** Error deleting file
			Call WriteLog("WARNING;Error during deletion of '" &amp; strXMLFilePath &amp; "'. Error: " &amp; Err.Description)
		End if


		'*** Create a new Template
		objXMLDoc.LoadXML("<?xml version=""1.0"" encoding=""utf-8""?><Tversity><MediaUrl><Url>http://myUrl.example</Url><Title>My Title |2y||2m||2d|</Title><Tags>OnDemandTV.MyProgram</Tags><Public>Yes</Public><Type>Video URL</Type><Schedule><WeekDay>Monday</WeekDay><LastUpdated></LastUpdated></Schedule><Schedule><WeekDay>Tuesday</WeekDay><LastUpdated></LastUpdated></Schedule></MediaUrl></Tversity>")
		objXMLDoc.Save(strXMLFilePath)			

		'*** Test if new if is correct.
		if objXMLDoc.parseError.ErrorCode <> 0 then
			'*** Error during reading of the XML Document
			Call WriteLog("ERROR;'CheckXMLFile' To Create a New '" &amp; strXMLFilePath &amp;"' Log file. Error: " &amp; Err.Description)
			CheckXMLFile=False
		Else
			Call WriteLog("INFO;'CheckXMLFile' created '" &amp; strXMLFilePath &amp; "' successfully!")
			CheckXMLFile=True
		End if	
	Else
		'*** Nothing to Do file is correct
		if (gDEBUG>=1) then WriteLog("DEBUG;'" &amp; strXMLFilePath &amp; "' exist and is a valid XML File!")
		CheckXMLFile=True
	End if	

Else
	'*** File Does Not Exist Create a new one.
	objXMLDoc.LoadXML("<VMState></VMState>")
	objXMLDoc.Save(strXMLFilePath)			

	'*** Test if new if is correct.
	if objXMLDoc.parseError.ErrorCode <> 0 then
		'*** Error during reading of the XML Document
		Call WriteLog("ERROR;'CheckXMLFile' To Create a New '" &amp; strXMLFilePath &amp;"' Log file. Error: " &amp; Err.Description)
		CheckXMLFile=False
	Else
		Call WriteLog("INFO;'CheckXMLFile' created '" &amp; strXMLFilePath &amp; "' successfully!")
		CheckXMLFile=True
	End if	

End if


set objXMLDoc = Nothing

End Function

Sub WriteLog(strData)
'*****************************************************
'*** Purpose: This procedure write log into a file
'*** Inputs : String of data to write on the file (only one line)
'*** gobjFso must be declared as global variable and initialized
'*** Returns: Nothing
'*****************************************************

If (gDEBUG=0) Then On Error Resume Next

Dim strLogFile		'*** STRING			Contains Path of the log files
Dim tsLogFile		'*** FileSystem Object		Object TextStream to manage files data
Dim objLogFile		'*** FileSystem Object		Object for the log files

'*** if DEBUG mode is activated... Print message on the console.
'if (gDEBUG=1) then wscript.echo strData

strLogFile=replace(wscript.ScriptFullName, ".vbs",".log")

If (Not gobjFso.FileExists(strLogFile)) Then
	'*** File doesn't exist -> create and write
	Call gobjFso.CreateTextFile(strLogFile, True)
Else
	'*** File Exist -> open and Write
	objLogFile=gobjFso.GetFile(strLogFile)
End If

'*** Create TextStream for file append (8) and ascii (0) mode
Set tsLogFile=gobjFso.OpenTextFile(strLogFile,8, False)

'*** Write Data on the file
tsLogFile.Writeline(now &amp; ";" &amp; strData)

tsLogFile.Close

End Sub

Sub WriteURL(strData)
'*****************************************************
'*** Purpose: This procedure write log into a file
'*** Inputs : String of data to write on the file (only one line)
'*** gobjFso must be declared as global variable and initialized
'*** Returns: Nothing
'*****************************************************

If (gDEBUG=0) Then On Error Resume Next

Dim strLogFile		'*** STRING			Contains Path of the log files
Dim tsLogFile		'*** FileSystem Object		Object TextStream to manage files data
Dim objLogFile		'*** FileSystem Object		Object for the log files

'*** if DEBUG mode is activated... Print message on the console.
'if (gDEBUG=1) then wscript.echo strData

strLogFile=replace(wscript.ScriptFullName, ".vbs","-URLs.txt")

If (Not gobjFso.FileExists(strLogFile)) Then
	'*** File doesn't exist -> create and write
	Call gobjFso.CreateTextFile(strLogFile, True)
Else
	'*** File Exist -> open and Write
	objLogFile=gobjFso.GetFile(strLogFile)
End If

'*** Create TextStream for file append (8) and ascii (0) mode
Set tsLogFile=gobjFso.OpenTextFile(strLogFile,8, False)

'*** Write Data on the file
tsLogFile.Writeline(strData)

tsLogFile.Close

End Sub

Some constant (all at the top of the script) have to be customized to make the script working

CONST_INPUTXMLFILEPATH : name of the XML input file
CONST_TVERSITYPATH : path of the tversity mediaserver mshare tool

Thanks for that, could be very handy for sites without a decent RSS feed

ps
Just a small thing, the server’s kinda slow and you might have thought your message had hung so hit send again a few times, resulting in multiple posts of the same message
Not a problem, just FYI

Very nice! I love the idea, this is really great. I bet there are many different rules that can evolve over time with regard to naming conventions used for new episodes.

Thanks for your feedback.
About new rules, I’ve only worked with date rules because all the shows I watch use that. But if you have some ideas for others rules (and URLs to test them) let me know. For example, I can easily adapt the script to have incremental kind of rules instead of date rules (like episode 1,2,3,4, etc.)

I will drop you a note once I come across something like that. I believe I have in the past but cannot remember where. Anyway, if these rules are not common enough, it is not worth implementing, so when something good comes along, you will figure it out.

Ok, Thanks! :)

your machine is set to play MPG files with QuickTime. try copy/pasting the URL into Windows Media Player.
[Moderator]Please do not put advertising urls as signature