File Coverage

blib/lib/Win32/IEAutomation.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Win32::IEAutomation;

use strict;
use Win32::OLE qw(EVENTS);

use Win32::IEAutomation::Element;
use Win32::IEAutomation::Table;
use Win32::IEAutomation::WinClicker;

use vars qw($VERSION $warn);
$VERSION = '0.5';

sub new {
	my $class = shift;
	my %options = @_;
	my $self = bless ({ }, $class);
	my ($visible, $maximize);
	if (exists $options{visible}){
		$visible = $options{visible};
	}else{
		$visible = 1;
	}
	if (exists $options{maximize}){
		$maximize = $options{maximize};
	}

	if (exists $options{warnings}){
		$warn = $options{warnings};
	}

	$self->_startIE($visible, $maximize);
}

sub _startIE{
	my ($self, $visible, $maximize) = @_;
	defined $self->{agent} and return;
	$self->{agent} = Win32::OLE->new("InternetExplorer.Application") || die "Could not start Internet Explorer Application through OLE\n";
	Win32::OLE->Option(Warn => 0);
	Win32::OLE->WithEvents($self->{agent});
	$self->{agent}->{Visible} = $visible;
	if ($maximize){
		my $clicker = Win32::IEAutomation::WinClicker->new();
		$clicker->maximize_ie();
		undef $clicker;
	}
	return $self;
}

sub getAgent {
	my $self = shift;
	$self->{agent};
}

sub getElement {
	my $self = shift;
	$self->{element};
}

sub closeIE{
	my $self = shift;
	my $agent = $self->{agent};
	$agent->Quit;
}

sub gotoURL{
	my ($self, $url, $nowait) = @_;
	my $agent = $self->{agent};
	$agent->Navigate($url);
	$self->WaitforDone unless $nowait;
}

sub Back{
	my $self = shift;
	my $agent = $self->{agent};
	$agent->GoBack;
	$self->WaitforDone;
}

sub Reload{
	my $self = shift;
	my $agent = $self->{agent};
	$agent->Refresh2;
	$self->WaitforDone;

}

sub URL{
	my $self = shift;
	my $agent = $self->{agent};
	$agent->LocationURL;
}

sub Title{
	my $self = shift;
	my $agent = $self->{agent};
	$agent->document->title;
}

sub Content{
	my $self = shift;
	my $agent = $self->{agent};
	my $html = $agent->document->documentElement->{outerHTML};
	$html =~ s/\r//g;
	my @file = split (/\n/, $html);
	if (wantarray){
		return @file;
	}else{
		return $html;
	}
}

# sub VerifyText{
# 	my ($self, $string) = @_;
# 	my @text = $self->PageText;
# 	foreach my $line (@text){
# 		$line =~ s/^\s+//;
# 		$line =~ s/\s+$//;
# 		if ($line eq $string || $line =~ m/$string/){
# 			return 1;
# 		}
# 	}
# }

sub VerifyText{
	my ($self, $string, $flag) = @_;
	$flag = 0 unless $flag;
	my $textrange = $self->{agent}->document->body->createTextRange;
	return $textrange->findText($string, 0 , $flag);
}

sub PageText{
	my $self = shift;
	my $text = $self->getAgent->document->documentElement->outerText;
	$text =~ s/\r//g;
	my @file = split (/\n/, $text);
	if (wantarray){
		return @file;
	}else{
		return $text;
	}
}

sub getLink{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my $links = $agent->Document->links;
	my $target_link = __getObject($links, $how, $what) if ($links);
	my $link_object;
	if ($target_link){
		$link_object = Win32::IEAutomation::Element->new();
		$link_object->{element} = $target_link;
		$link_object->{parent} = $self;
	}else{
		$link_object = undef;
		print "WARNING: No link is  present in the document with your specified option $how $what\n" if $warn;
	}
	return $link_object;
}

sub getAllLinks{
	my $self = shift;
	my $agent = $self->{agent};
	my @links_array;
	my $links = $agent->Document->links;
	for (my $n = 0; $n <= $links->length - 1; $n++){
		my $link_object = Win32::IEAutomation::Element->new();
		$link_object->{element} = $links->item($n);
		$link_object->{parent} = $self;
		push (@links_array, $link_object);
	}
	return @links_array;
}

sub getButton{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my $buttons = $agent->Document->all->tags("input");
	my $target_button = __getObject($buttons, $how, $what) if ($buttons);
	my $button_object;
	if ($target_button){
		$button_object = Win32::IEAutomation::Element->new();
		$button_object->{element} = $target_button;
		$button_object->{parent} = $self;
	}else{
		$button_object = undef;
		print "WARNING: No button is  present in the document with your specified option $how $what\n" if $warn;
	}
	return $button_object;
}

sub getImage{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my $images = $agent->Document->images;
	my $target_image = __getObject($images, $how, $what) if ($images);
	my $image_object;
	if ($target_image){
		$image_object = Win32::IEAutomation::Element->new();
		$image_object->{element} = $target_image;
		$image_object->{parent} = $self;
	}else{
		$image_object = undef;
		print "WARNING: No image is  present in the document with your specified option $how $what\n" if $warn;
	}
	return $image_object;
}

sub getAllImages{
	my $self = shift;
	my $agent = $self->{agent};
	my @image_array;
	my $images = $agent->Document->images;
	for (my $n = 0; $n <= $images->length - 1; $n++){
		my $image_object = Win32::IEAutomation::Element->new();
		$image_object->{element} = $images->item($n);
		$image_object->{parent} = $self;
		push (@image_array, $image_object);
	}
	return @image_array;
}

sub getRadio{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my $inputs;
	if ($how eq "beforetext:" || $how eq "aftertext:"){
		$inputs = $agent->Document->all;
	}else{
		$inputs = $agent->Document->all->tags("input");
	}
	my $target_radio = __getObject($inputs, $how, $what, "radio") if ($inputs);
	my $radio_object;
	if ($target_radio){
		$radio_object = Win32::IEAutomation::Element->new();
		$radio_object->{element} = $target_radio;
		$radio_object->{parent} = $self;
	}else{
		$radio_object = undef;
		print "WARNING: No radio button is  present in the document with your specified option $how $what\n" if $warn;
	}
	return $radio_object;
}

sub getCheckbox{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my $inputs;
	if ($how eq "beforetext:" || $how eq "aftertext:"){
		$inputs = $agent->Document->all;
	}else{
		$inputs = $agent->Document->all->tags("input");
	}
	my $target_checkbox = __getObject($inputs, $how, $what, "checkbox") if ($inputs);
	my $checkbox_object;
	if ($target_checkbox){
		$checkbox_object = Win32::IEAutomation::Element->new();
		$checkbox_object->{element} = $target_checkbox;
		$checkbox_object->{parent} = $self;
	}else{
		$checkbox_object = undef;
		print "WARNING: No checkbox is  present in the document with your specified option $how $what\n" if $warn;
	}
	return $checkbox_object;
}

sub getSelectList{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my $select_lists = $agent->Document->all->tags("select");
	my $target_list = __getObject($select_lists, $how, $what, "select-one|select-multiple") if ($select_lists);
	my $list_object;
	if ($target_list){
		$list_object = Win32::IEAutomation::Element->new();
		$list_object->{element} = $target_list;
		$list_object->{parent} = $self;
	}else{
		$list_object = undef;
		print "WARNING: No select list is  present in the document with your specified option $how $what\n" if $warn;
	}
	return $list_object;
}

sub getTextBox{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my ($inputs, $target_field);
	if ($how eq "beforetext:" || $how eq "aftertext:"){
		$inputs = $agent->Document->all;
	}else{
		$inputs = $agent->Document->all->tags("input");
	}
	if ($inputs){
		$target_field = __getObject($inputs, $how, $what, "text|password|file");
	}
	my $text_object;
	if ($target_field){
		$text_object = Win32::IEAutomation::Element->new();
		$text_object->{element} = $target_field;
		$text_object->{parent} = $self;
	}else{
		$text_object = undef;
		print "WARNING: No text box is present in the document with your specified option $how $what\n" if $warn;
	}
	return $text_object;
}

sub getTextArea{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my ($inputs, $target_field);
	if ($how eq "beforetext:" || $how eq "aftertext:"){
		$inputs = $agent->Document->all;
	}else{
		$inputs = $agent->Document->all->tags("textarea");
	}
	if ($inputs){
		$target_field = __getObject($inputs, $how, $what, "textarea");
	}
	my $text_object;
	if ($target_field){
		$text_object = Win32::IEAutomation::Element->new();
		$text_object->{element} = $target_field;
		$text_object->{parent} = $self;
	}else{
		$text_object = undef;
		print "WARNING: No text area is present in the document with your specified option $how $what\n" if $warn;
	}
	return $text_object;
}

sub getTable{
	my ($self, $how, $what) = @_;
	my $agent = $self->{agent};
	my ($inputs, $target_table);
	if ($how eq "beforetext:" || $how eq "aftertext:"){
		$inputs = $agent->Document->all;
	}else{
		$inputs = $agent->Document->all->tags("table");
	}
	if ($inputs){
		$target_table = __getObject($inputs, $how, $what);
	}
	my $table_object;
	if ($target_table){
		$table_object = Win32::IEAutomation::Table->new();
		$table_object->{table} = $target_table;
		$table_object->{parent} = $self;
	}else{
		$table_object = undef;
		print "WARNING: No table is present in the document with your specified option $how $what\n" if $warn;
	}
	return $table_object;
}

sub getAllTables{
	my $self = shift;
	my $agent = $self->{agent};
	my @links_array;
	my $links = $agent->Document->all->tags("table");
	for (my $n = 0; $n < $links->length; $n++){
		my $link_object = Win32::IEAutomation::Element->new();
		$link_object->{element} = $links->item($n);
		$link_object->{parent} = $self;
		push (@links_array, $link_object);
	}
	return @links_array;
}

sub __getObject{
	my ($coll, $how, $what, $type) = @_;
	my ($aftertext_flag, $input, $index_counter, $regex_flag);
	$regex_flag = 1 if ($what =~ /^?-xism:/);
	for (my $n = 0; $n <= $coll->length - 1; $n++){

			if ($how eq "linktext:") {
				my $text = $coll->item($n)->outerText;
				$text = trim_white_spaces($text);
				if ($regex_flag){
					return $coll->item($n) if ($text =~ $what);
				}else{
					return $coll->item($n) if ($text eq $what);
				}
			}

			elsif ($how eq "tabtext:") {
				my $text = $coll->item($n)->outerText;
				$text = trim_white_spaces($text);
				if ($regex_flag){
					return $coll->item($n) if ($text =~ $what);
				}else{
					return $coll->item($n) if ($text eq $what);
				}
			}

			elsif ($how eq "id:") {
				my $id = $coll->item($n)->id;
				return $coll->item($n) if ($id eq $what);
			}

			elsif ($how eq "name:") {
				my $name = $coll->item($n)->name;
				if ($regex_flag){
					return $coll->item($n) if ($name =~ $what);
				}else{
					return $coll->item($n) if ($name eq $what);
				}
			}

			elsif ($how eq "value:") {
				my $value = $coll->item($n)->value;
				if ($regex_flag){
					return $coll->item($n) if ($value =~ $what);
				}else{
					return $coll->item($n) if ($value eq $what);
				}
			}

			elsif ($how eq "class:") {
				my $class = $coll->item($n)->{className};
				if ($regex_flag){
					return $coll->item($n) if ($class =~ $what);
				}else{
					return $coll->item($n) if ($class eq $what);
				}
			}

			elsif ($how eq "index:") {
				$index_counter++ if ($coll->item($n)->type =~ m/^($type)$/);
				return $coll->item($n) if ($index_counter == $what);
			}

			elsif ($how eq "caption:") {
				my $value = $coll->item($n)->value;
				if ($regex_flag){
					return $coll->item($n) if ($value =~ $what);
				}else{
					return $coll->item($n) if ($value eq $what);
				}
			}

			elsif ($how eq "linkurl:") {
				my $url = $coll->item($n)->href;
				if ($regex_flag){
					return $coll->item($n) if ($url =~ $what);
				}else{
					return $coll->item($n) if ($url eq $what);
				}
			}

			elsif ($how eq "imgurl:") {
				my $imgurl = $coll->item($n)->src;
				if ($regex_flag){
					return $coll->item($n) if ($imgurl =~ $what);
				}else{
					return $coll->item($n) if ($imgurl eq $what);
				}
			}

			elsif ($how eq "alt:") {
				my $imgurl = $coll->item($n)->alt;
				if ($regex_flag){
					return $coll->item($n) if ($imgurl =~ $what);
				}else{
					return $coll->item($n) if ($imgurl eq $what);
				}
			}

			elsif ($how eq "beforetext:") {
				$input =  $coll->item($n) if ($coll->item($n)->tagname eq "INPUT");
				my $text = $coll->item($n)->getAdjacentText("beforeEnd");
				$text = trim_white_spaces($text);
				if ($regex_flag){
					return $input if ($text =~ $what);
				}else{
					return $input if ($text eq $what);
				}
				$text = $coll->item($n)->getAdjacentText("afterEnd");
				$text = trim_white_spaces($text);
				if ($regex_flag){
					return $input if ($text =~ $what);
				}else{
					return $input if ($text eq $what);
				}
			}

			elsif ($how eq "aftertext:") {
				undef $input;
				$input =  $coll->item($n) if (($coll->item($n)->tagName =~ m/^(INPUT|TEXTAREA)$/) && $coll->item($n)->type =~ m/^($type)$/);
				#print $coll->item($n)->{type}."\n" if ($aftertext_flag == 1 && $input);
				return $input if ($aftertext_flag == 1 && $input);
				unless ($aftertext_flag){
					my $text = $coll->item($n)->getAdjacentText("beforeEnd");
					$text = trim_white_spaces($text);
					if ($regex_flag){
						$aftertext_flag = 1 if ($text =~ $what);
					}else{
						$aftertext_flag = 1 if ($text eq $what);
					}
					$text = $coll->item($n)->getAdjacentText("afterEnd");
					$text = trim_white_spaces($text);
					if ($regex_flag){
						$aftertext_flag = 1 if ($text =~ $what);
					}else{
						$aftertext_flag = 1 if ($text eq $what);
					}
				}
		 }

		 else{
			 print "WARNING: \'$how\' is not supported to get the object\n";
		 }

	}
}

sub getFrame{
	my ($self, $how, $what) = @_;
	my $target_frame;
	my $agent = $self->{agent};
	my $frames = $agent->Document->frames;
	$target_frame = __getObject($frames, $how, $what) if ($frames);
	if ($target_frame){
		my %frame = %{$self};
		my $frameref = \%frame;
		$frameref->{agent} = $target_frame;
		bless $frameref;
		return $frameref;
	}else{
		print "WARNING: No frame is present in the document with your specified option $how $what\n" if $warn;
	}
}

sub getPopupWindow{
	my ($self, $what, $wait) = @_;
	my $counter;
	$wait = 2 unless $wait;
	while($counter <= $wait ){
		my $shApp = Win32::OLE->new("Shell.Application") || die "Could not start Shell.Application\n";
		my $windows = $shApp->Windows;
		for (my $n = 0; $n <= $windows->count - 1; $n++){
			my $window = $windows->Item($n);
			my $title = $window->document->title if $window;
			if ($title eq $what){
				my %popup = %{$self};
				my $popupref = \%popup;
				$popupref->{agent} = $window;
				bless $popupref;
				$popupref->WaitforDone;
				return $popupref;
			}
		}
		sleep 1;
		$counter++
	}
	print "WARNING: No popup window is present with your specified title: $what\n" if $warn;
}

sub WaitforDone{
	my $self = shift;
	my $agent = $self->{agent};
	while ($agent->Busy || $agent->document->readystate ne "complete"){
		sleep 1;
	}
}

sub WaitforDocumentComplete{
	my $self = shift;
	my $agent = $self->{agent};
	while ($agent->document->readystate ne "complete"){
		sleep 1;
	}
}

sub trim_white_spaces{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

1;
__END__