use strict; use lib 'support'; use LWP::UserAgent; use HTTP::Request::Common; use URI::Escape; use Win32::Clipboard; use Win32::Console; use Win32::Process; use Win32::TieRegistry (Delimiter => '/'); use Win32::GuiTest qw(SendKeys FindWindowLike MouseMoveAbsPix GetScreenRes GetClassName GetDesktopWindow IsKeyPressed); use Win32::PerfLib; our $home = 'e:\\era-testing'; our $buildIDFile = "$home\\support\\build-id.dat"; our $buildFile = "$home\\support\\installer.exe"; our $pendingFile = 'URIs-pending.dat'; our $doneFile = 'URIs-done.dat'; our $errorFile = 'URIs-errors.dat'; our $platformGroup = 'intel windows'; our $branch = 'core1'; our $timeout = 20; # seconds to wait for typical things our $console = new Win32::Console; our $clipboard = Win32::Clipboard(); our $process = undef; our %counterNames; Win32::PerfLib::GetCounterNames('', \%counterNames); our %counterIDs = map { $counterNames{$_} => $_ } keys %counterNames; our $processObjectID = $counterIDs{'Process'}; # retrieve the id for process object our $processIDID = $counterIDs{'ID Process'}; # retrieve the id for the process ID counter our $processorTimeID = $counterIDs{'% Processor Time'}; # retrieve the id for the % processor time counter our %doneURIs; our @URIs; our $aborted = 0; my $originalTitle = $console->Title(); status(); loadURIs(); print "Press and hold NUM LOCK to abort.\n"; print "Press and hold CAPS LOCK to pause on a page.\n"; print "Press SCROLL LOCK for a second to log a page as buggy.\n"; while (@URIs and not aborted()) { eval { # install build my $lastBuildID = cat($buildIDFile); my($buildURI, $buildID) = getLatestBuild(); if ($buildID ne $lastBuildID) { closeProcess(); uninstallBuild(); downloadBuild($buildURI); installBuild(); save($buildIDFile, $buildID); } if (not process()) { openProcess(); } runTest(); }; if ($@ and not aborted()) { my $error = $@; print "Failed: $error\n"; status(); closeProcess(); } if (not @URIs and not aborted()) { foreach (keys %doneURIs) { addURIFrom($_); } } saveURIs(); } closeProcess(); if ($aborted) { print "Aborted.\n"; } else { print "No more pending URIs. Add more URIs to '$pendingFile'.\n"; } $console->Title($originalTitle); sub aborted { $aborted ||= IsKeyPressed('NUM'); return $aborted; } sub getLatestBuild { status('Getting latest build...'); my $platform = uri_escape($platformGroup); my $branch = uri_escape($branch); my $response = LWP::UserAgent->new()->request(HTTP::Request->new(GET => "http://spartan/?command=getLatestBuild&platform=$platform&branch=$branch")); if ($response->code != 200) { my $line = $response->status_line; my $data = $response->content; if (length $data) { $data = ".\nData from server was:\n$data"; } else { $data = ' and did not return any data.'; } die "Spartan did not return 200 OK (returned '$line' instead)$data\n"; } return split(/\n/, $response->content); } sub uninstallBuild { status('Uninstalling...'); # first delete the profile link (so that installer can delete entire directory) #my $a = operaAlternateProfileDirectory(); # might not be a link but that's ok #invoke("support\\linkd.exe \"$a\" /D") if -e $a; # next, run the uninstaller my $directory = operaInstallDirectory() . '\UnInst'; if (chdir $directory) { my $process; if (Win32::Process::Create($process, 'UNWISE.EXE', 'UNWISE.EXE /s Install.log', 0, NORMAL_PRIORITY_CLASS, '.')) { # hold on until opera has finished uninstalling unless ($process->Wait(300 * 1000)) { $process->Kill(0); } else { } } else { warn Win32::FormatMessage(Win32::GetLastError()) . "\n"; } } else { } # now nuke everything in case the uninstaller sucked chdir $home; wipe(operaInstallDirectory()); wipe(operaProfileDirectory()); # Finally, empty the registry delete $Registry->{'HKEY_CURRENT_USER/SOFTWARE/Opera Software/'}; } sub downloadBuild { my($uri) = @_; status('Downloading...'); my $response = LWP::UserAgent->new()->request(HTTP::Request->new(GET => $uri), $buildFile); die "Couldn't save build file to $buildFile: " . $response->as_string . "\n" unless $response->is_success; die "Couldn't save build file to $buildFile.\n" unless -f $buildFile && -s $buildFile; } sub installBuild { status('Installing...'); # launch installer my $process; Win32::Process::Create($process, $buildFile, "\"$buildFile\" /s", 0, NORMAL_PRIORITY_CLASS, '.') || die Win32::FormatMessage(Win32::GetLastError()) . "\n"; # hold on until it has finished installing unless ($process->Wait(300 * 1000)) { $process->Kill(0); die "Installer timed out.\n"; } #die "Installer exitted with non-zero return code.\n" if $process->GetExitCode(); ## create a symlink so that wherever the profile ends up, we ## can use the same path for it #my $a = operaAlternateProfileDirectory(); # install dir + /profile #my $b = operaProfileDirectory(); # windows profile dir + /opera #if (-e $a and not -e $b) { # ($b, $a) = ($a, $b); #} #invoke("support\\linkd.exe \"$a\" \"$b\"") or die "Couldn't create symlink for profile.\n"; # create the config file my $config = operaIniPath(); readyDirectoryForFile($config); open(FILE, '>', $config) || die "Couldn't create configuration file $config: $!.\n"; print FILE <GetProcessID(); # get the performance data for the process object my $perfLib = new Win32::PerfLib(''); my $perfData = {}; $perfLib->GetObjectList($processObjectID, $perfData); $perfLib->Close(); instance: foreach my $instance (values %{$perfData->{Objects}->{$processObjectID}->{Instances}}) { my $targetCounter = undef; my $neededBitsFound = 0; counter: foreach my $counter (values %{$instance->{Counters}}) { if ($counter->{CounterNameTitleIndex} == $processIDID) { return 1 if $counter->{Counter} == $pid; } } } return 0; } sub closeProcess { status('Shutting down process...'); eval { SendKeys '%{F4}'; if (process() and not $process->Wait($timeout * 1000)) { $process->Kill(0); } }; $process = undef; } sub openProcess { status('Launching process...'); # check INI file ensureConfigFile(); # start up our opera build Win32::Process::Create($process, operaInstallDirectory() . '\opera.exe', "\"" . operaInstallDirectory() . "\\opera.exe\"", 0, NORMAL_PRIORITY_CLASS, '.') || die Win32::FormatMessage(Win32::GetLastError()) . ".\n"; waitForWindow(); SendKeys '{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}'; SendKeys '%{SPACE}r%{SPACE}s{UP}{LEFT}'; MouseMoveAbsPix(0, 0); SendKeys '{ENTER}'; } sub runTest { my $testURI = shift @URIs; status($testURI); $doneURIs{$testURI} = 1; eval { $clipboard->Set($testURI); SendKeys '{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}{ESC}'; SendKeys '^w^w^w^w^w^w^w^w^w^w^w^w'; SendKeys '%{SPACE}r%{SPACE}s{DOWN}{RIGHT}'; MouseMoveAbsPix(GetScreenRes()); SendKeys '{ENTER}'; SendKeys '^n^v{ENTER}'; SendKeys '%vf'; # ERA mode MouseMoveAbsPix(GetScreenRes()); addURIFrom($testURI); waitForLoaded(); MouseMoveAbsPix(0, 0); runTestForResolution(800, $testURI); runTestForResolution(640, $testURI); runTestForResolution(480, $testURI); runTestForResolution(320, $testURI); runTestForDynamicResolution(200, 800, $testURI); die "Build crashed.\n" unless process(); }; if ($@ and not aborted()) { errorLog($testURI, $@); die $@; } } sub runTestForResolution { my($w, $URI) = @_; die "Build crashed.\n" unless process(); die "Aborted.\n" if aborted(); SendKeys '%{SPACE}r%{SPACE}s{DOWN}{RIGHT}'; MouseMoveAbsPix($w, 1100); SendKeys '{ENTER}{HOME}'; status('CAPS LOCK pauses'); IsKeyPressed('SCR'); # reset the IsKeyPressed detection SendKeys '{PAUSE 1500}{PGDN}{PAUSE 500}{PGDN}{PAUSE 500}{END}{PAUSE 500}{PGUP}{PAUSE 150}{PGUP}{PAUSE 150}{HOME}{PAUSE 500}'; my $log = 0; if (IsKeyPressed('CAP')) { status('SCROLL LOCK logs'); print "\nURI: $URI\n"; print "Width: $w pixels\n"; print "Press SCROLL LOCK to log this file as buggy.\n"; while (IsKeyPressed('CAP')) { SendKeys '{PAUSE 100}'; if (IsKeyPressed('SCR') and not $log) { print "Logging $URI as buggy at width $w.\n"; $log = 1; } die "Aborted.\n" if aborted(); } status($URI); } elsif (IsKeyPressed('SCR')) { print "\nLogging $URI as buggy at width $w.\n"; $log = 1; } if ($log) { errorLog($URI, $w); } status(); } sub runTestForDynamicResolution { my($w1, $w2, $URI) = @_; die "Build crashed.\n" unless process(); die "Aborted.\n" if aborted(); SendKeys '%{SPACE}r%{SPACE}s{DOWN}{RIGHT}'; status('CAPS LOCK pauses'); IsKeyPressed('SCR'); # reset the IsKeyPressed detection my $log = 0; my @w = ($w1 .. $w2); @w = (@w, reverse @w); foreach my $w (@w) { MouseMoveAbsPix($w, 1100); SendKeys '{PAUSE 50}'; if (IsKeyPressed('CAP')) { status('SCROLL LOCK logs'); print "\nURI: $URI\n"; print "Width: $w pixels\n"; print "Press SCROLL LOCK to log this file as buggy.\n"; while (IsKeyPressed('CAP')) { SendKeys '{PAUSE 100}'; if (IsKeyPressed('SCR') and not $log) { print "Logging $URI as buggy at width $w.\n"; $log = $w; } die "Aborted.\n" if aborted(); } status('CAPS LOCK pauses'); } elsif (IsKeyPressed('SCR')) { print "\nLogging $URI as buggy at width $w.\n"; $log = $w; } last if $log; } SendKeys '{ENTER}{HOME}'; if ($log) { errorLog($URI, 'dynamic ($log)'); } status(); } sub errorLog { local $" = ' '; open(my $file, '>>', $errorFile) or die "Can't save to '$errorFile': $!"; print $file "@_\n" or die "Can't save to '$errorFile': $!"; close($file) or die "Can't save to '$errorFile': $!"; } sub addURIFrom { my($URI) = @_; my $data = LWP::UserAgent->new(agent => '')->request(HTTP::Request->new(GET => $URI))->content; while (scalar($data =~ m|"(http://[^" ]+)"|gos)) { if (not exists $doneURIs{$1}) { push(@URIs, $1); return; } } } sub cat { open(my $file, '<', $_[0]) or return ''; local $/ = undef; return (<$file>); } sub save { open(my $file, '>', $_[0]) or die "Can't save to '$_[0]': $!"; print $file $_[1] or die "Can't save to '$_[0]': $!"; close($file) or die "Can't save to '$_[0]': $!"; } # this checks that the opera6.ini file is in a sane state # basically at the moment all that is checked is that Run=1 is # not set in the [State] section. (that would indicate a crash) sub ensureConfigFile { my $config = operaIniPath(); open(FILE, '<', $config) || die "Couldn't read configuration file $config: $!.\n"; my $output = ''; my $section = ''; while (defined($_ = )) { if (m/^\[(.*)\]\n$/os) { $section = $1; } else { if ($section eq "State") { if (m/^Run=1\n$/os) { $_ = "Run=0\n"; } } } $output .= $_; } close FILE; open(FILE, '>', $config) || die "Couldn't open configuration file $config: $!.\n"; print FILE $output || die "Couldn't update configuration file $config: $!.\n"; close FILE; } sub readyDirectoryForFile { my($file) = @_; my @parts = split(/\\/, $file); pop @parts; my $pwd = ''; foreach (@parts) { $pwd = length($pwd) ? "$pwd\\$_" : $_; die "Couldn't prepare directory for $file: $pwd exists.\n" if -e $pwd and not -d $pwd; mkdir $pwd unless -e $pwd; } die "Failed to create directory for '$file'.\n" unless -e $pwd; } sub operaInstallDirectory { my $key = $Registry->{'HKEY_CURRENT_USER/SOFTWARE/Opera Software/'}; if ($key) { my $value = $key->{'/Last Directory3'}; return $value if $value; $value = $key->{'/Last Beta Directory'}; return $value if $value; } return "$ENV{ProgramFiles}\\Opera"; } sub operaProfileDirectory { return "$ENV{USERPROFILE}\\Application Data\\Opera"; } sub operaAlternateProfileDirectory { my $path = operaInstallDirectory(); return "$path\\profile"; } sub operaIniPath { my $path = operaInstallDirectory(); $path =~ s/.+\\//os; return operaProfileDirectory() . "\\$path\\profile\\opera6.ini"; } sub delay { my($time) = @_; if ($time < 10) { sleep $time; return; } foreach (0..$time-1) { status('' . ($time - $_) . 's remaining...'); sleep 1; } status(); } sub status { if (@_) { local $" = ' '; $console->Title("@_"); } else { $console->Title('ERA Testing'); } } sub wipe { if ($^O eq 'linux') { invoke('/bin/rm', '-rf', $_[0]) or die "Couldn't delete '$_[0]': $!\n"; } elsif ($^O eq 'MSWin32') { if (-d $_[0]) { invoke($ENV{COMSPEC}, "/c rmdir /S /Q \"$_[0]\"") or die "Couldn't delete directory '$_[0]': $!\n"; } elsif (-e $_[0]) { invoke($ENV{COMSPEC}, "/c del /Q \"$_[0]\"") or die "Couldn't delete '$_[0]': $!\n"; } } else { die "Platform '$^O' not supported.\n"; } } sub invoke { local $" = ' '; system(@_); if ($? == -1) { warn "'@_' failed to execute: $!\n"; return 0; } elsif ($? & 127) { warn sprintf("'@_' died with signal %d%s.\n", ($? & 127), ($? & 128) ? ', with a coredump' : ''); return 0; } elsif ($? >> 8 > 0) { warn sprintf("'@_' returned with exit value %d.\n", $? >> 8); return 0; } else { return 1; } } sub FindOneWindowLike { my @results = FindWindowLike(@_); return @results ? $results[0] : undef; } sub waitForWindow { my $start = time(); my $window; while (not $window = FindOneWindowLike(GetDesktopWindow(), 'Opera', '^OpWindow$', undef, 1)) { my $elapsed = time() - $start; if ($elapsed > $timeout) { return 0; } sleep 1; } return $window; } sub waitForLoaded { my($window) = @_; my $start = time(); while (isLoading($window)) { my $elapsed = time() - $start; if ($elapsed > $timeout) { return 0; } sleep 1; } return 1; } sub isLoading($) { my($window) = @_; my @children = FindWindowLike($window, undef, undef, undef, 2); $window = undef; foreach (@children) { if (GetClassName($_) eq 'OperaWindowClass') { $window = $_; last; } } return 0 unless $window; # hello? @children = FindWindowLike($window, undef, undef, undef, 2); return 0 unless @children == 2; # no really, wtf if (FindWindowLike($children[0], undef, '^OperaWindowClass$', undef, 2)) { # this is the ad banner, grab the other one $window = $children[1]; } else { # this is not the ad banner, grab it $window = $children[0]; } @children = FindWindowLike($window, undef, undef, undef, 2); foreach $window (@children) { # these are all the open windows # if any of them have more than one subwindow, then opera is showing a progress bar return 1 if FindWindowLike($window, undef, undef, undef, 2) > 1; } return 0; # no open windows, or, no windows that are busy } sub loadURIs { %doneURIs = map { $_ => 1 } split(/\n/, cat($doneFile)); @URIs = split(/\n/, cat($pendingFile)); } sub saveURIs { save($doneFile, join("\n", keys %doneURIs)); save($pendingFile, join("\n", @URIs)); }