// Web content test
// written by Bernard Stepien
//	bernard.stepien@sympatico.ca

// Note: the three test case examples are and adaptation in TCCN-3 
// of the three examples drawn from the following paper:
//Rigorous and Automatic Testing of Web Applications
//Xiaoping Jia and Hongming Liu
//School of Computer Science, Telecommunication and Information Systems
///DePaul University
//Chicago, Illinois, USA
//email: fxjia, jordang@cs.depaul.edu

module dePaul_web_content_test 
{
	const integer maxDepth := 3;

	type record of charstring HrefListType;

	type record hyperlink_response_type 
	{
		charstring status,
		HrefListType hrefList
	}

	template charstring main_page_web_url := "file:web_page_1.html";

	template hyperlink_response_type hyperlink_response :=
	{
		status := "HTTP/1.1 200 OK",
		hrefList := ?
	}

	//template charstring program_page_web_url := "http://www.cs.depaul.edu/program";
	template charstring program_page_web_url := "file:depaul_main_page.html";
	template charstring testhref_page_web_url := "http://jordan.cs.depaul.edu/webtest/testhref.htm";

	type record content_response_type 
	{
		charstring status,
		charstring content
	}

	template content_response_type content_response_pred :=
	{
		status := "HTTP/1.1 200 OK",
		content := pattern "*<BODY*Undergraduate Degree*Master Degree*</BODY>*"
	}

	template content_response_type content_response_quan_pred :=
	{
		status := "HTTP/1.1 200 OK",
		//content := pattern "*<a href=\"[ [^[H|h]]|[H|h][^[T|t]]|[H|h][T|t][^[T|t]]|[H|h][T|t][T|t][^[P|p]]|[H|h][T|t][T|t][P|p][^:]]*\"*"
		content := "file:*"
	}

	type port web message {
		in hyperlink_response_type, HrefListType, content_response_type;	
			inout charstring;
	}

	type component MTCType {
		port web web_port;
	}

	  type component SystemType {
		port web system_web_port;
	  }


	// example 1 from DePaul university paper

	/**********************
	This is a recursive link checker (web crawler) with maximum depth

	<testcase name="Link check">
		<teststep name="link check 1">
			<request url="http://www.cs.depaul.edu", recursive="true", recursivedepth="3"/>
			<response statuscode="200"/>
		</teststep>
	</testcase>
	***********************/

	testcase Link_Check_TC() runs on MTCType system SystemType {
		var integer depth;
		//var hyperlink_response_type theHyperlink_response;
		var verdicttype theOverallVerdict;

		map(mtc:web_port, system:system_web_port);

		theOverallVerdict := CheckChildLink(main_page_web_url, 1);

		setverdict(theOverallVerdict);
	}

	function CheckChildLink(charstring theURLLink, integer theDepth) runs on MTCType return verdicttype {

		var hyperlink_response_type theHyperlink_response;
		var charstring theBadResponse;
		var verdicttype theFinalVerdict := pass;
		var verdicttype oneVerdict;

		log("testing link: " & theURLLink);

		web_port.send(theURLLink);
		alt 
		{
			[] web_port.receive(hyperlink_response) -> value theHyperlink_response
				{
					if(theDepth <= maxDepth)
					{
						var integer theNewDepth;
						var HrefListType theResponseHrefList := theHyperlink_response.hrefList;
						var integer numOfLinks := sizeof(theResponseHrefList);
						var integer i;

						theNewDepth := theDepth + 1;

						for(i:=0; i < numOfLinks; i:=i+1)
						{
							oneVerdict := CheckChildLink(theResponseHrefList[i], theNewDepth);

							if(oneVerdict == fail)
							{
								theFinalVerdict := fail;
							}
						}
					}
				}
			[] web_port.receive(charstring:?) -> value theBadResponse
				{
					log("the URL: " & theURLLink & " did not work, response: " & theBadResponse);

					theFinalVerdict := fail;
				}
		}

		return theFinalVerdict;
	}

	// end of example 1

	// example 2

	/***********************************
	this test case check for a particular text or subtexts in the HTML body
	
	<testcase name="Content check using predicates">
		<teststep name="Content check step one">
			<request url="http://www.cs.depaul.edu/program"/>
			<response statuscode="200">
				<and>
					<or>
						<match op="contains" regexp="false" select="/html/body" value="Undergraduate Degree"/>
						<match op="contains" regexp="false" select="/html/body" value="Bachelor Degree"/>
					</or>
					<match op="contains" regexp="true" select="/html/body value="[M|m]aster [D|d]egree"/>
				</and>
			</response>
		</teststep>
	</testcase>
	****************************************/

	testcase Content_check_pred_TC() runs on MTCType system SystemType {
		var verdicttype theOverallVerdict;

		map(mtc:web_port, system:system_web_port);

		theOverallVerdict := CheckContent_pred(program_page_web_url, content_response_pred);

		setverdict(theOverallVerdict);
	}


	// end of example 2

	// example 3

	/***********************************
	this test case performs a look up of returned links for a particular protocol
	
	<testsuite>
		<testcase name="Content check using quantified predicates">
			<teststep name="content check step one" >
				<request url="http://jordan.cs.depaul.edu/webtest/testhref.htm">
				</request>
				<response>
					<forall>
						<varbale name="l" select="descendent::a/@href"/>
						<match op="startswith" select="$l" regexp="false" value="http://"/>
					</forall>
				</response>
			</teststep>
		</testcase>
	</testsuite>
	********************************/

	// end of example 3

	function CheckContent_pred(charstring theURLLink, content_response_type theContent_response) runs on MTCType return verdicttype {
		var charstring theBadResponse;
		var verdicttype theFinalVerdict;

		log ("in CheckContent_pred sending: " & theURLLink);

		web_port.send(theURLLink);
		alt 
		{
			[] web_port.receive(theContent_response)
				{
					theFinalVerdict := pass;
				}
			[] web_port.receive(charstring:?) -> value theBadResponse
				{
					log("Bad Response: " & theBadResponse);

					theFinalVerdict := fail;
				}
		}

		return theFinalVerdict;
	}

	testcase Forall_protocol_check_TC(charstring theURLLink, charstring theProtocol) runs on MTCType system SystemType {
		var hyperlink_response_type theHyperlink_response;
		var charstring theBadResponse;
		var boolean all_match;

		map(mtc:web_port, system:system_web_port);

		web_port.send(theURLLink);
		alt 
		{
			[] web_port.receive(hyperlink_response) -> value theHyperlink_response
				{
					var HrefListType theResponseHrefList := theHyperlink_response.hrefList;
					var integer numOfLinks := sizeof(theResponseHrefList);
					var integer i;
					var integer theLength := lengthof(theProtocol);

					all_match := true;

					for(i:=0; i < numOfLinks; i:=i+1)
					{
						//if(substr(theResponseHrefList[i],0,theLength) != theProtocol)
						if( match(theResponseHrefList[i], pattern "file:*")) {
							all_match := true	
						}
						else {
							all_match := false;
							log("link: " & theResponseHrefList[i] & " is not of protocol " & theProtocol);
						}
					}

					if(all_match)
					{
						setverdict(pass);
					}
					else
					{
						setverdict(fail);
					}
				}
			[] web_port.receive(charstring:?) -> value theBadResponse
				{
					log("the URL: " & theURLLink & " did not work, response: " & theBadResponse);

					setverdict(fail);
				}
		}
	}

	control {
		execute(Link_Check_TC());
		execute(Content_check_pred_TC());
		execute(Forall_protocol_check_TC(main_page_web_url, "file:"))
	}

}