2006-02-08 02:01:49 +03:00
#!/usr/bin/perl -w
# -*- mode: cperl; c-basic-offset: 8; indent-tabs-mode: nil; -*-
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is Litmus.
#
# The Initial Developer of the Original Code is
# the Mozilla Corporation.
# Portions created by the Initial Developer are Copyright (C) 2006
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
# Chris Cooper <ccooper@deadsquid.com>
# Zach Lipton <zach@zachlipton.com>
#
# ***** END LICENSE BLOCK *****
use strict ;
$| + + ;
use lib qw( .. ) ;
use Getopt::Long ;
use Litmus::Config ;
use DBI ( ) ;
use Data::Dumper ;
2006-08-02 00:50:15 +04:00
2006-02-08 02:01:49 +03:00
use vars qw(
$ tr_dbh
$ litmus_dbh
2006-04-06 23:39:35 +04:00
$ force
2006-02-08 02:01:49 +03:00
) ;
2006-04-06 23:39:35 +04:00
GetOptions ( 'force' = > \ $ force ) ;
2006-02-08 02:01:49 +03:00
END {
if ( $ tr_dbh ) { $ tr_dbh - > disconnect ; }
if ( $ litmus_dbh ) { $ litmus_dbh - > disconnect ; }
}
$ litmus_dbh = & connect_litmus ( ) or die ;
$ tr_dbh = & connect_testrunner ( ) or die ;
my ( $ sql , $ sth ) ;
2006-08-15 20:41:51 +04:00
$ sql = "SELECT name,testgroup_id,testrunner_plan_id FROM testgroups WHERE testrunner_plan_id is not NULL" ;
2006-02-08 02:01:49 +03:00
$ sth = $ litmus_dbh - > prepare ( $ sql ) ;
$ sth - > execute ( ) ;
my $ testgroups ;
while ( my ( $ name , $ tg_id , $ tr_p_id ) = $ sth - > fetchrow_array ) {
$ testgroups - > { $ tg_id } - > { 'name' } = $ name ;
$ testgroups - > { $ tg_id } - > { 'tr_p_id' } = $ tr_p_id ;
}
$ sth - > finish ;
my $ testcases_updated = 0 ;
foreach my $ id ( keys %$ testgroups ) {
# Get existing Litmus subgroups.
2006-08-15 20:41:51 +04:00
$ sql = "SELECT sg.name,sg.subgroup_id,sg.testrunner_group_id FROM subgroups sg, subgroup_testgroups sgtg WHERE sg.subgroup_id=sgtg.subgroup_id AND sgtg.testgroup_id=?" ;
2006-02-08 02:01:49 +03:00
$ sth = $ litmus_dbh - > prepare ( $ sql ) ;
$ sth - > execute ( $ id ) ;
my $ subgroups ;
while ( my ( $ name , $ s_id , $ tr_g_id ) = $ sth - > fetchrow_array ) {
if ( ! $ tr_g_id ) {
print "# No TR info for subgroup ID: $s_id, $name\n" ;
next ;
}
$ subgroups - > { $ tr_g_id } - > { 'name' } = $ name ;
$ subgroups - > { $ tr_g_id } - > { 's_id' } = $ s_id ;
}
$ sth - > finish ;
# Get all subgroups from Testrunner.
$ sql = "SELECT name,group_id FROM test_case_groups WHERE plan_id=?" ;
$ sth = $ tr_dbh - > prepare ( $ sql ) ;
$ sth - > execute ( $ testgroups - > { $ id } - > { 'tr_p_id' } ) ;
my $ tr_subgroups ;
while ( my ( $ name , $ s_id ) = $ sth - > fetchrow_array ) {
$ tr_subgroups - > { $ s_id } - > { 'name' } = $ name ;
}
$ sth - > finish ;
# Check for missing subgroups in Litmus.
foreach my $ s_id ( keys %$ tr_subgroups ) {
if ( exists $ subgroups - > { $ s_id } ) {
$ subgroups - > { $ s_id } - > { 'exists' } = 1 ;
next ;
}
$ subgroups - > { $ s_id } - > { 'new' } = 1 ;
$ subgroups - > { $ s_id } - > { 'name' } = $ tr_subgroups - > { $ s_id } - > { 'name' } ;
}
# Deal with new subgroups.
# XXX: not written yet.
# Get testcases for each subgroup.
foreach my $ tr_g_id ( keys %$ subgroups ) {
2006-08-15 20:41:51 +04:00
$ sql = "SELECT t.testcase_id,t.summary,t.steps,t.expected_results,t.author_id,t.version,t.testrunner_case_id,t.testrunner_case_version FROM testcases t, testcase_subgroups tsg WHERE t.testcase_id=tsg.testcase_id AND tsg.subgroup_id=?" ;
2006-02-08 02:01:49 +03:00
$ sth = $ litmus_dbh - > prepare ( $ sql ) ;
$ sth - > execute ( $ subgroups - > { $ tr_g_id } - > { 's_id' } ) ;
my @ testcases ;
while ( my $ testcase = $ sth - > fetchrow_hashref ) {
push @ testcases , $ testcase ;
}
$ sth - > finish ;
foreach my $ testcase ( @ testcases ) {
if ( ! $ testcase - > { 'testrunner_case_id' } ) {
2006-08-15 20:41:51 +04:00
print "# No TR info for testcase ID: " . $ testcase - > { 'testcase_id' } . ", " . $ testcase - > { 'summary' } . ", tr_g_id: $tr_g_id\n" ;
2006-02-08 02:01:49 +03:00
next ;
}
$ sql = "SELECT tct.case_id,tct.case_version,tct.summary,tct.action,tct.effect FROM test_cases_texts tct, test_cases t WHERE t.case_id=tct.case_id AND t.case_id=? ORDER BY tct.case_version DESC LIMIT 1" ;
$ sth = $ tr_dbh - > prepare ( $ sql ) ;
$ sth - > execute ( $ testcase - > { 'testrunner_case_id' } ) ;
my $ tr_testcase = $ sth - > fetchrow_hashref ;
$ sth - > finish ;
if ( ! $ tr_testcase ) {
print "# No TR testcase found for case ID: " . $ testcase - > { 'testrunner_case_id' } . ", subgroup_id: " . $ subgroups - > { $ tr_g_id } - > { 's_id' } . ", testgroup_id: $id\n" ;
next ;
}
# Compare our two testcases.
next if ( $ testcase - > { 'testrunner_case_version' } == $ tr_testcase - > { 'case_version' } ) ;
# If the corresponding test has been update in both Litmus _and_
# Testrunner, warn the user, give them enough info to easily fix the
# problem manually, and continue to the next testcase without updating.
2006-04-06 23:39:35 +04:00
if ( ! $ force and
$ testcase - > { 'version' } > $ testcase - > { 'testrunner_case_version' } and
2006-02-08 02:01:49 +03:00
$ tr_testcase - > { 'case_version' } > $ testcase - > { 'testrunner_case_version' } ) {
print "# Testcase update collision detected.\n" ;
2006-08-15 20:41:51 +04:00
print "# Litmus testcase ID#: " . $ testcase - > { 'testcase_id' } . "; TR case ID#: " . $ tr_testcase - > { 'case_id' } . "\n" ;
2006-02-08 02:01:49 +03:00
next ;
}
$ tr_testcase - > { 'summary' } =~ s/'/\\'/g ;
$ tr_testcase - > { 'action' } =~ s/'/\\'/g ;
$ tr_testcase - > { 'effect' } =~ s/'/\\'/g ;
$ tr_testcase - > { 'summary' } =~ s/\&/\&/g ;
$ tr_testcase - > { 'action' } =~ s/\&/\&/g ;
$ tr_testcase - > { 'effect' } =~ s/\&/\&/g ;
$ tr_testcase - > { 'summary' } =~ s/^\s+//g ;
$ tr_testcase - > { 'action' } =~ s/^\s+//g ;
$ tr_testcase - > { 'effect' } =~ s/^\s+//g ;
$ tr_testcase - > { 'summary' } =~ s/\s+$//g ;
$ tr_testcase - > { 'action' } =~ s/\s+$//g ;
$ tr_testcase - > { 'effect' } =~ s/\s+$//g ;
2006-08-15 20:41:51 +04:00
my $ update_cmd = "UPDATE testcases SET version=" . $ tr_testcase - > { 'case_version' } .
2006-02-08 02:01:49 +03:00
",testrunner_case_version=" . $ tr_testcase - > { 'case_version' } .
",summary='" . $ tr_testcase - > { 'summary' } .
"',steps='" . $ tr_testcase - > { 'action' } .
"',expected_results='" . $ tr_testcase - > { 'effect' } .
2006-08-15 20:41:51 +04:00
"',last_updated=NOW() WHERE testcase_id=" .
$ testcase - > { 'testcase_id' } . ";\n" ;
2006-02-08 02:01:49 +03:00
print $ update_cmd ;
$ testcases_updated + + ;
}
}
}
print "# Testcases updated: $testcases_updated\n" ;
exit ;
#########################################################################
sub usage () {
print "Usage: ./update_litmus_from_testrunner.pl\n\n" ;
}
#########################################################################
sub connect_testrunner () {
my $ dsn = "dbi:mysql:" . $ Litmus:: Config:: tr_name .
":" . $ Litmus:: Config:: tr_host ;
my $ dbh = DBI - > connect ( $ dsn ,
$ Litmus:: Config:: tr_user ,
$ Litmus:: Config:: tr_pass )
|| die "Could not connect to mysql database $Litmus::Config::tr_name" ;
return $ dbh ;
}
#########################################################################
sub connect_litmus () {
my $ dsn = "dbi:mysql:" . $ Litmus:: Config:: db_name .
":" . $ Litmus:: Config:: db_host ;
my $ dbh = DBI - > connect ( $ dsn ,
$ Litmus:: Config:: db_user ,
$ Litmus:: Config:: db_pass )
|| die "Could not connect to mysql database $Litmus::Config::db_name" ;
return $ dbh ;
}