view release on metacpan or  search on metacpan

lib/Mozilla/Mechanize/GUITester.pm  view on Meta::CPAN

	my $home = $ENV{HOME};
	my $td = tempdir("/tmp/mozilla_guitester_XXXXXX", CLEANUP => 1);
	local $ENV{HOME} = $td;
	local $ENV{MOZ_NO_REMOTE} = 1;
	my $self = shift()->SUPER::new(@_);
	$self->{_home} = $td;
	$self->{_popups} = {};
	$self->{_alerts} = '';
	$self->{_console_messages} = [];

	$self->{_window_id} = $self->agent->{window}->window->XWINDOW;
	confess("# Unable to find window id") unless $self->window_id;

	Mozilla::PromptService::Register({ DEFAULT => sub {
		my $name = shift;
		$self->{_popups}->{$name} = [ @_ ];
		$self->{_alerts} .= $_[2] . "\n";
	} , Confirm => sub { return $self->{_confirm_result} }
	, Prompt => sub { return $self->{_prompt_result}; } });
	$self->{_reqs_count} = 0;
	Mozilla::ObserverService::Register({
		'http-on-examine-response' => sub {
			$self->_N('http-on-examine-response');
			my $channel = shift;
			$self->{_response_status} = $channel->responseStatus;
			$self->{_reqs_count}-- if $self->{_reqs_count} > 0;
		}, "http-on-modify-request" => sub {
			$self->_N('http-on-modify-request');
			$self->{_reqs_count}++;
		}, "http-on-examine-cached-response" => sub {
			$self->_N('http-on-examine-cached-response');
			$self->{_reqs_count}-- if $self->{_reqs_count} > 0;
 		}
	});
	$self->{_console_handle} = Mozilla::ConsoleService::Register(sub {
		my $msg = shift;
		push @{ $self->console_messages }, $msg if $msg;
	});
	return $self;
}

sub _countdown_requests {
	my ($self) = @_;
	$self->_N(join("", Carp::longmess()) . "_countdown_requests");
	$self->_wait_for_gtk;
	my $n = 1;
	while ($self->{_reqs_count} > 0) {
		$self->_N("iteration $n");
		my $rq = $self->{_reqs_count};
		$self->_wait_for_gtk;

		next if $rq != $self->{_reqs_count};
		if (($n++ % 50) == 0) {
			$self->_N("forcing reqs count");
			$self->{_reqs_count}--;
		}
	}
	$self->_N("_countdown_requests finish");
}

sub _wait_while_busy {
	my $self = shift;
	$self->_countdown_requests; 
	$self->{$_} = undef for qw(forms cur_form links images);
	return 1;
}
 
=head1 ACCESSORS

=head2 $mech->status

Returns last response status using Mozilla::ObserverService and
nsIHTTPChannel:responseStatus function.

Note that it works only for HTTP requests.

=cut
sub status { return shift()->{_response_status}; }

=head2 $mech->last_alert

Returns last alert contents intercepted through Mozilla::PromptService.

It is useful for communication from javascript.

=cut
sub last_alert { return shift()->{_popups}->{Alert}->[2]; }

=head2 $mech->console_messages

Returns arrayref of all console messages (e.g. javascript errors) aggregated
so far.

See Mozilla nsIConsoleService documentation for more details.

=cut
sub console_messages { return shift()->{_console_messages}; }

=head2 $mech->window_id

Returns window id of guitester window.

=cut
sub window_id { return shift()->{_window_id}; }

=head1 METHODS

=head2 $mech->x_resize_window($width, $height)

Resizes window to $width, $height. Dies if the screen is too small for it.

=cut
sub x_resize_window {
	my ($self, $width, $height) = @_;
	my ($x, $y) = GetScreenRes();
	die "Screen width is too small: $x < $width" if ($x < $width);
	die "Screen height is too small: $y < $height" if ($y < $height);
	ResizeWindow($self->window_id, $width, $height);
}

=head2 $mech->pull_alerts