[ONOS-7495]: Refactor Wiki Test Result Graph R Scripts
Change-Id: Iccbe89838bba21af276463e73091341063dc7b39
diff --git a/TestON/JenkinsFile/wikiGraphRScripts/dependencies/cliArgs.R b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/cliArgs.R
new file mode 100644
index 0000000..e48a5dc
--- /dev/null
+++ b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/cliArgs.R
@@ -0,0 +1,60 @@
+# Copyright 2017 Open Networking Foundation (ONF)
+#
+# Please refer questions to either the onos test mailing list at <onos-test@onosproject.org>,
+# the System Testing Plans and Results wiki page at <https://wiki.onosproject.org/x/voMg>,
+# or the System Testing Guide page at <https://wiki.onosproject.org/x/WYQg>
+#
+# TestON is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# TestON is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with TestON. If not, see <http://www.gnu.org/licenses/>.
+#
+# If you have any questions, or if you don't understand R,
+# please contact Jeremy Ronquillo: j_ronquillo@u.pacific.edu
+
+database_host <- 1
+database_host_str <- "<database-host>"
+
+database_port <- 2
+database_port_str <- "<database-port>"
+
+database_u_id <- 3
+database_u_id_str <- "<database-user-id>"
+
+database_pw <- 4
+database_pw_str <- "<database-password>"
+
+graph_title <- 5
+graph_title_str <- "<graph-title>"
+
+branch_name <- 6
+branch_name_str <- "<branch-name>"
+
+save_directory_str <- "<directory-to-save-graph>"
+
+usage <- function( filename, specialArgsList = c() ){
+ special_args_str = ""
+ for ( a in specialArgsList) {
+ special_args_str = paste( special_args_str, "<", a, "> ", sep="" )
+ }
+ output <- paste( "Usage: Rscript",
+ filename,
+ database_host_str,
+ database_port_str,
+ database_u_id_str,
+ database_pw_str,
+ graph_title_str,
+ branch_name_str,
+ special_args_str,
+ sep=" " )
+ output <- paste( output, save_directory_str, sep="" )
+ print( output )
+}
\ No newline at end of file
diff --git a/TestON/JenkinsFile/wikiGraphRScripts/dependencies/fundamentalGraphData.R b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/fundamentalGraphData.R
new file mode 100644
index 0000000..e2c4ed8
--- /dev/null
+++ b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/fundamentalGraphData.R
@@ -0,0 +1,56 @@
+# Copyright 2017 Open Networking Foundation (ONF)
+#
+# Please refer questions to either the onos test mailing list at <onos-test@onosproject.org>,
+# the System Testing Plans and Results wiki page at <https://wiki.onosproject.org/x/voMg>,
+# or the System Testing Guide page at <https://wiki.onosproject.org/x/WYQg>
+#
+# TestON is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# TestON is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with TestON. If not, see <http://www.gnu.org/licenses/>.
+#
+
+graphTheme <- function(){
+ theme( plot.title = element_text( hjust = 0.5, size = 32, face ='bold' ),
+ axis.text.x = element_text( angle = 0, size = 14 ),
+ legend.position = "bottom",
+ legend.text = element_text( size = 22 ),
+ legend.title = element_blank(),
+ legend.key.size = unit( 1.5, 'lines' ),
+ legend.direction = 'horizontal',
+ plot.subtitle = element_text( size=16, hjust=1.0 ) )
+}
+
+webColor <- function( color ){
+ switch( color,
+ red = "#FF0000",
+ redv2 = "#FF6666", # more readable version of red
+ green = "#33CC33",
+ blue = "#0033FF",
+ light_blue = "#3399FF",
+ black = "#111111",
+ yellow = "#EEB600",
+ purple = "#9900FF",
+ gray = "#CCCCCC",
+ darkerGray = "#666666" )
+}
+
+wrapLegend <- function(){
+ guides( color = guide_legend( nrow = 2, byrow = TRUE ) )
+}
+
+lastUpdatedLabel <- function(){
+ paste( "Last Updated: ", format( Sys.time(), format = "%b %d, %Y at %I:%M %p %Z" ), sep="" )
+}
+
+defaultTextSize <- function(){
+ theme_set( theme_grey( base_size = 26 ) ) # set the default text size of the graph.
+}
\ No newline at end of file
diff --git a/TestON/JenkinsFile/wikiGraphRScripts/dependencies/initSQL.R b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/initSQL.R
new file mode 100644
index 0000000..dec5f2e
--- /dev/null
+++ b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/initSQL.R
@@ -0,0 +1,154 @@
+# Copyright 2018 Open Networking Foundation (ONF)
+#
+# Please refer questions to either the onos test mailing list at <onos-test@onosproject.org>,
+# the System Testing Plans and Results wiki page at <https://wiki.onosproject.org/x/voMg>,
+# or the System Testing Guide page at <https://wiki.onosproject.org/x/WYQg>
+#
+# TestON is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# TestON is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with TestON. If not, see <http://www.gnu.org/licenses/>.
+#
+# If you have any questions, or if you don't understand R,
+# please contact Jeremy Ronquillo: j_ronquillo@u.pacific.edu
+
+pipelineMinValue = 1000
+
+initSQL <- function( host, port, user, pass ) {
+ dbConnect( dbDriver( "PostgreSQL" ),
+ dbname = "onostest",
+ host = host,
+ port = strtoi( port ),
+ user = user,
+ password = pass )
+}
+
+simpleSQLCommand <- function( testName, branch, limit=0 ){
+ paste( "SELECT * FROM executed_test_tests WHERE actual_test_name='",
+ testName,
+ "' AND branch='",
+ branch,
+ "' ORDER BY date DESC ",
+ if (limit > 0) "LIMIT " else "",
+ if (limit > 0) limit else "",
+ sep="" )
+}
+
+retrieveData <- function( con, sqlCommand ){
+
+ print( "Sending SQL command:" )
+ print( sqlCommand )
+
+ result <- dbGetQuery( con, sqlCommand )
+
+ # Check if data has been received
+ if ( nrow( result ) == 0 ){
+ print( "[ERROR]: No data received from the databases. Please double check this by manually running the SQL command." )
+ quit( status = 1 )
+ }
+ result
+}
+
+generateMultiTestMultiBuildSQLCommand <- function( branch, testsToInclude, buildsToShow ){
+ tests <- getTestList( testsToInclude )
+ multiTestSQLCommand( branch, tests, buildsToShow, TRUE )
+}
+
+generateMultiTestSingleBuildSQLCommand <- function( branch, testsToInclude, buildToShow ){
+ tests <- getTestList( testsToInclude )
+ operator <- "= "
+ if ( buildToShow == "latest" ){
+ operator <- ">= "
+ buildToShow <- "1000"
+ }
+
+ multiTestSQLCommand( branch, tests, buildToShow, FALSE, operator )
+}
+
+generateGroupedTestSingleBuildSQLCommand <- function( branch, groupsToInclude, buildToShow ){
+ operator <- "= "
+ if( buildToShow == "latest" ){
+ operator <- ">= "
+ buildToShow <- "1000"
+ }
+
+ tests <- strsplit( groupsToInclude, ";" )
+
+ sqlCommands <- c()
+
+ for( i in 1:length( tests[[1]] ) ){
+ splitTestList <- strsplit( tests[[1]][ i ], "-" )
+ testList <- splitTestList[[1]][2]
+
+ testsCommand <- "'"
+ for ( test in as.list( strsplit( testList, "," )[[1]] ) ){
+ testsCommand <- paste( testsCommand, test, "','", sep="" )
+ }
+ testsCommand <- substr( testsCommand, 0, nchar( testsCommand ) - 2 )
+
+ sqlCommands = c( sqlCommands, multiTestSQLCommand( branch, testsCommand, buildToShow, FALSE, operator ) )
+ }
+ sqlCommands
+}
+
+getTitlesFromGroupTest <- function( branch, groupsToInclude ){
+ tests <- strsplit( groupsToInclude, ";" )
+ titles <- list()
+ for( i in 1:length( tests[[1]] ) ){
+ splitTestList <- strsplit( tests[[1]][ i ], "-" )
+ titles[[i]] <- splitTestList[[1]][1]
+ }
+ titles
+}
+
+getTestList <- function( testsToInclude ){
+ tests <- "'"
+ for ( test in as.list( strsplit( testsToInclude, "," )[[1]] ) ){
+ tests <- paste( tests, test, "','", sep="" )
+ }
+ tests <- substr( tests, 0, nchar( tests ) - 2 )
+ tests
+}
+
+multiTestSQLCommand <- function( branch, tests, builds, isDisplayingMultipleBuilds, operator=">= " ){
+ if ( isDisplayingMultipleBuilds ){
+ operator2 <- "<="
+ multipleBuildsToShow <- builds
+ singleBuild <- pipelineMinValue
+ }
+ else{
+ operator2 <- "="
+ multipleBuildsToShow <- 1
+ singleBuild <- builds
+ }
+
+ paste( "SELECT * ",
+ "FROM executed_test_tests a ",
+ "WHERE ( SELECT COUNT( * ) FROM executed_test_tests b ",
+ "WHERE b.branch='",
+ branch,
+ "' AND b.actual_test_name IN (",
+ tests,
+ ") AND a.actual_test_name = b.actual_test_name AND a.date <= b.date AND b.build ", operator,
+ singleBuild,
+ " ) ",
+ operator2,
+ " ",
+ multipleBuildsToShow,
+ " AND a.branch='",
+ branch,
+ "' AND a.actual_test_name IN (",
+ tests,
+ ") AND a.build ", operator,
+ singleBuild,
+ " ORDER BY a.actual_test_name DESC, a.date DESC",
+ sep="")
+}
diff --git a/TestON/JenkinsFile/wikiGraphRScripts/dependencies/saveGraph.R b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/saveGraph.R
new file mode 100644
index 0000000..257ad8d
--- /dev/null
+++ b/TestON/JenkinsFile/wikiGraphRScripts/dependencies/saveGraph.R
@@ -0,0 +1,42 @@
+# Copyright 2017 Open Networking Foundation (ONF)
+#
+# Please refer questions to either the onos test mailing list at <onos-test@onosproject.org>,
+# the System Testing Plans and Results wiki page at <https://wiki.onosproject.org/x/voMg>,
+# or the System Testing Guide page at <https://wiki.onosproject.org/x/WYQg>
+#
+# TestON is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# TestON is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with TestON. If not, see <http://www.gnu.org/licenses/>.
+#
+# If you have any questions, or if you don't understand R,
+# please contact Jeremy Ronquillo: j_ronquillo@u.pacific.edu
+
+imageWidth <- 15
+imageHeight <- 10
+imageDPI <- 200
+
+saveGraph <- function( outputFile ){
+ print( paste( "Saving result graph to", outputFile ) )
+
+ tryCatch( ggsave( outputFile,
+ width = imageWidth,
+ height = imageHeight,
+ dpi = imageDPI ),
+ error = function( e ){
+ print( "[ERROR]: There was a problem saving the graph due to a graph formatting exception. Error dump:" )
+ print( e )
+ quit( status = 1 )
+ }
+ )
+
+ print( paste( "[SUCCESS]: Successfully wrote result graph out to", outputFile ) )
+}
\ No newline at end of file