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


line stmt bran cond sub pod time code
1             package Win32::IEAutomation;
2            
3 1     1   22437 use strict;
  1         2  
  1         43  
4 1     1   367 use Win32::OLE qw(EVENTS);
  0            
  0            
5            
6             use Win32::IEAutomation::Element;
7             use Win32::IEAutomation::Table;
8             use Win32::IEAutomation::WinClicker;
9            
10             use vars qw($VERSION $warn);
11             $VERSION = '0.5';
12            
13             sub new {
14             my $class = shift;
15             my %options = @_;
16             my $self = bless ({ }, $class);
17             my ($visible, $maximize);
18             if (exists $options{visible}){
19             $visible = $options{visible};
20             }else{
21             $visible = 1;
22             }
23             if (exists $options{maximize}){
24             $maximize = $options{maximize};
25             }
26            
27             if (exists $options{warnings}){
28             $warn = $options{warnings};
29             }
30            
31             $self->_startIE($visible, $maximize);
32             }
33            
34             sub _startIE{
35             my ($self, $visible, $maximize) = @_;
36             defined $self->{agent} and return;
37             $self->{agent} = Win32::OLE->new("InternetExplorer.Application") || die "Could not start Internet Explorer Application through OLE\n";
38             Win32::OLE->Option(Warn => 0);
39             Win32::OLE->WithEvents($self->{agent});
40             $self->{agent}->{Visible} = $visible;
41             if ($maximize){
42             my $clicker = Win32::IEAutomation::WinClicker->new();
43             $clicker->maximize_ie();
44             undef $clicker;
45             }
46             return $self;
47             }
48            
49             sub getAgent {
50             my $self = shift;
51             $self->{agent};
52             }
53            
54             sub getElement {
55             my $self = shift;
56             $self->{element};
57             }
58            
59             sub closeIE{
60             my $self = shift;
61             my $agent = $self->{agent};
62             $agent->Quit;
63             }
64            
65             sub gotoURL{
66             my ($self, $url, $nowait) = @_;
67             my $agent = $self->{agent};
68             $agent->Navigate($url);
69             $self->WaitforDone unless $nowait;
70             }
71            
72             sub Back{
73             my $self = shift;
74             my $agent = $self->{agent};
75             $agent->GoBack;
76             $self->WaitforDone;
77             }
78            
79             sub Reload{
80             my $self = shift;
81             my $agent = $self->{agent};
82             $agent->Refresh2;
83             $self->WaitforDone;
84            
85             }
86            
87             sub URL{
88             my $self = shift;
89             my $agent = $self->{agent};
90             $agent->LocationURL;
91             }
92            
93             sub Title{
94             my $self = shift;
95             my $agent = $self->{agent};
96             $agent->document->title;
97             }
98            
99             sub Content{
100             my $self = shift;
101             my $agent = $self->{agent};
102             my $html = $agent->document->documentElement->{outerHTML};
103             $html =~ s/\r//g;
104             my @file = split (/\n/, $html);
105             if (wantarray){
106             return @file;
107             }else{
108             return $html;
109             }
110             }
111            
112             # sub VerifyText{
113             # my ($self, $string) = @_;
114             # my @text = $self->PageText;
115             # foreach my $line (@text){
116             # $line =~ s/^\s+//;
117             # $line =~ s/\s+$//;
118             # if ($line eq $string || $line =~ m/$string/){
119             # return 1;
120             # }
121             # }
122             # }
123            
124             sub VerifyText{
125             my ($self, $string, $flag) = @_;
126             $flag = 0 unless $flag;
127             my $textrange = $self->{agent}->document->body->createTextRange;
128             return $textrange->findText($string, 0 , $flag);
129             }
130            
131             sub PageText{
132             my $self = shift;
133             my $text = $self->getAgent->document->documentElement->outerText;
134             $text =~ s/\r//g;
135             my @file = split (/\n/, $text);
136             if (wantarray){
137             return @file;
138             }else{
139             return $text;
140             }
141             }
142            
143             sub getLink{
144             my ($self, $how, $what) = @_;
145             my $agent = $self->{agent};
146             my $links = $agent->Document->links;
147             my $target_link = __getObject($links, $how, $what) if ($links);
148             my $link_object;
149             if ($target_link){
150             $link_object = Win32::IEAutomation::Element->new();
151             $link_object->{element} = $target_link;
152             $link_object->{parent} = $self;
153             }else{
154             $link_object = undef;
155             print "WARNING: No link is present in the document with your specified option $how $what\n" if $warn;
156             }
157             return $link_object;
158             }
159            
160             sub getAllLinks{
161             my $self = shift;
162             my $agent = $self->{agent};
163             my @links_array;
164             my $links = $agent->Document->links;
165             for (my $n = 0; $n <= $links->length - 1; $n++){
166             my $link_object = Win32::IEAutomation::Element->new();
167             $link_object->{element} = $links->item($n);
168             $link_object->{parent} = $self;
169             push (@links_array, $link_object);
170             }
171             return @links_array;
172             }
173            
174             sub getButton{
175             my ($self, $how, $what) = @_;
176             my $agent = $self->{agent};
177             my $buttons = $agent->Document->all->tags("input");
178             my $target_button = __getObject($buttons, $how, $what) if ($buttons);
179             my $button_object;
180             if ($target_button){
181             $button_object = Win32::IEAutomation::Element->new();
182             $button_object->{element} = $target_button;
183             $button_object->{parent} = $self;
184             }else{
185             $button_object = undef;
186             print "WARNING: No button is present in the document with your specified option $how $what\n" if $warn;
187             }
188             return $button_object;
189             }
190            
191             sub getImage{
192             my ($self, $how, $what) = @_;
193             my $agent = $self->{agent};
194             my $images = $agent->Document->images;
195             my $target_image = __getObject($images, $how, $what) if ($images);
196             my $image_object;
197             if ($target_image){
198             $image_object = Win32::IEAutomation::Element->new();
199             $image_object->{element} = $target_image;
200             $image_object->{parent} = $self;
201             }else{
202             $image_object = undef;
203             print "WARNING: No image is present in the document with your specified option $how $what\n" if $warn;
204             }
205             return $image_object;
206             }
207            
208             sub getAllImages{
209             my $self = shift;
210             my $agent = $self->{agent};
211             my @image_array;
212             my $images = $agent->Document->images;
213             for (my $n = 0; $n <= $images->length - 1; $n++){
214             my $image_object = Win32::IEAutomation::Element->new();
215             $image_object->{element} = $images->item($n);
216             $image_object->{parent} = $self;
217             push (@image_array, $image_object);
218             }
219             return @image_array;
220             }
221            
222             sub getRadio{
223             my ($self, $how, $what) = @_;
224             my $agent = $self->{agent};
225             my $inputs;
226             if ($how eq "beforetext:" || $how eq "aftertext:"){
227             $inputs = $agent->Document->all;
228             }else{
229             $inputs = $agent->Document->all->tags("input");
230             }
231             my $target_radio = __getObject($inputs, $how, $what, "radio") if ($inputs);
232             my $radio_object;
233             if ($target_radio){
234             $radio_object = Win32::IEAutomation::Element->new();
235             $radio_object->{element} = $target_radio;
236             $radio_object->{parent} = $self;
237             }else{
238             $radio_object = undef;
239             print "WARNING: No radio button is present in the document with your specified option $how $what\n" if $warn;
240             }
241             return $radio_object;
242             }
243            
244             sub getCheckbox{
245             my ($self, $how, $what) = @_;
246             my $agent = $self->{agent};
247             my $inputs;
248             if ($how eq "beforetext:" || $how eq "aftertext:"){
249             $inputs = $agent->Document->all;
250             }else{
251             $inputs = $agent->Document->all->tags("input");
252             }
253             my $target_checkbox = __getObject($inputs, $how, $what, "checkbox") if ($inputs);
254             my $checkbox_object;
255             if ($target_checkbox){
256             $checkbox_object = Win32::IEAutomation::Element->new();
257             $checkbox_object->{element} = $target_checkbox;
258             $checkbox_object->{parent} = $self;
259             }else{
260             $checkbox_object = undef;
261             print "WARNING: No checkbox is present in the document with your specified option $how $what\n" if $warn;
262             }
263             return $checkbox_object;
264             }
265            
266             sub getSelectList{
267             my ($self, $how, $what) = @_;
268             my $agent = $self->{agent};
269             my $select_lists = $agent->Document->all->tags("select");
270             my $target_list = __getObject($select_lists, $how, $what, "select-one|select-multiple") if ($select_lists);
271             my $list_object;
272             if ($target_list){
273             $list_object = Win32::IEAutomation::Element->new();
274             $list_object->{element} = $target_list;
275             $list_object->{parent} = $self;
276             }else{
277             $list_object = undef;
278             print "WARNING: No select list is present in the document with your specified option $how $what\n" if $warn;
279             }
280             return $list_object;
281             }
282            
283             sub getTextBox{
284             my ($self, $how, $what) = @_;
285             my $agent = $self->{agent};
286             my ($inputs, $target_field);
287             if ($how eq "beforetext:" || $how eq "aftertext:"){
288             $inputs = $agent->Document->all;
289             }else{
290             $inputs = $agent->Document->all->tags("input");
291             }
292             if ($inputs){
293             $target_field = __getObject($inputs, $how, $what, "text|password|file");
294             }
295             my $text_object;
296             if ($target_field){
297             $text_object = Win32::IEAutomation::Element->new();
298             $text_object->{element} = $target_field;
299             $text_object->{parent} = $self;
300             }else{
301             $text_object = undef;
302             print "WARNING: No text box is present in the document with your specified option $how $what\n" if $warn;
303             }
304             return $text_object;
305             }
306            
307             sub getTextArea{
308             my ($self, $how, $what) = @_;
309             my $agent = $self->{agent};
310             my ($inputs, $target_field);
311             if ($how eq "beforetext:" || $how eq "aftertext:"){
312             $inputs = $agent->Document->all;
313             }else{
314             $inputs = $agent->Document->all->tags("textarea");
315             }
316             if ($inputs){
317             $target_field = __getObject($inputs, $how, $what, "textarea");
318             }
319             my $text_object;
320             if ($target_field){
321             $text_object = Win32::IEAutomation::Element->new();
322             $text_object->{element} = $target_field;
323             $text_object->{parent} = $self;
324             }else{
325             $text_object = undef;
326             print "WARNING: No text area is present in the document with your specified option $how $what\n" if $warn;
327             }
328             return $text_object;
329             }
330            
331             sub getTable{
332             my ($self, $how, $what) = @_;
333             my $agent = $self->{agent};
334             my ($inputs, $target_table);
335             if ($how eq "beforetext:" || $how eq "aftertext:"){
336             $inputs = $agent->Document->all;
337             }else{
338             $inputs = $agent->Document->all->tags("table");
339             }
340             if ($inputs){
341             $target_table = __getObject($inputs, $how, $what);
342             }
343             my $table_object;
344             if ($target_table){
345             $table_object = Win32::IEAutomation::Table->new();
346             $table_object->{table} = $target_table;
347             $table_object->{parent} = $self;
348             }else{
349             $table_object = undef;
350             print "WARNING: No table is present in the document with your specified option $how $what\n" if $warn;
351             }
352             return $table_object;
353             }
354            
355             sub getAllTables{
356             my $self = shift;
357             my $agent = $self->{agent};
358             my @links_array;
359             my $links = $agent->Document->all->tags("table");
360             for (my $n = 0; $n < $links->length; $n++){
361             my $link_object = Win32::IEAutomation::Element->new();
362             $link_object->{element} = $links->item($n);
363             $link_object->{parent} = $self;
364             push (@links_array, $link_object);
365             }
366             return @links_array;
367             }
368            
369             sub __getObject{
370             my ($coll, $how, $what, $type) = @_;
371             my ($aftertext_flag, $input, $index_counter, $regex_flag);
372             $regex_flag = 1 if ($what =~ /^?-xism:/);
373             for (my $n = 0; $n <= $coll->length - 1; $n++){
374            
375             if ($how eq "linktext:") {
376             my $text = $coll->item($n)->outerText;
377             $text = trim_white_spaces($text);
378             if ($regex_flag){
379             return $coll->item($n) if ($text =~ $what);
380             }else{
381             return $coll->item($n) if ($text eq $what);
382             }
383             }
384            
385             elsif ($how eq "tabtext:") {
386             my $text = $coll->item($n)->outerText;
387             $text = trim_white_spaces($text);
388             if ($regex_flag){
389             return $coll->item($n) if ($text =~ $what);
390             }else{
391             return $coll->item($n) if ($text eq $what);
392             }
393             }
394            
395             elsif ($how eq "id:") {
396             my $id = $coll->item($n)->id;
397             return $coll->item($n) if ($id eq $what);
398             }
399            
400             elsif ($how eq "name:") {
401             my $name = $coll->item($n)->name;
402             if ($regex_flag){
403             return $coll->item($n) if ($name =~ $what);
404             }else{
405             return $coll->item($n) if ($name eq $what);
406             }
407             }
408            
409             elsif ($how eq "value:") {
410             my $value = $coll->item($n)->value;
411             if ($regex_flag){
412             return $coll->item($n) if ($value =~ $what);
413             }else{
414             return $coll->item($n) if ($value eq $what);
415             }
416             }
417            
418             elsif ($how eq "class:") {
419             my $class = $coll->item($n)->{className};
420             if ($regex_flag){
421             return $coll->item($n) if ($class =~ $what);
422             }else{
423             return $coll->item($n) if ($class eq $what);
424             }
425             }
426            
427             elsif ($how eq "index:") {
428             $index_counter++ if ($coll->item($n)->type =~ m/^($type)$/);
429             return $coll->item($n) if ($index_counter == $what);
430             }
431            
432             elsif ($how eq "caption:") {
433             my $value = $coll->item($n)->value;
434             if ($regex_flag){
435             return $coll->item($n) if ($value =~ $what);
436             }else{
437             return $coll->item($n) if ($value eq $what);
438             }
439             }
440            
441             elsif ($how eq "linkurl:") {
442             my $url = $coll->item($n)->href;
443             if ($regex_flag){
444             return $coll->item($n) if ($url =~ $what);
445             }else{
446             return $coll->item($n) if ($url eq $what);
447             }
448             }
449            
450             elsif ($how eq "imgurl:") {
451             my $imgurl = $coll->item($n)->src;
452             if ($regex_flag){
453             return $coll->item($n) if ($imgurl =~ $what);
454             }else{
455             return $coll->item($n) if ($imgurl eq $what);
456             }
457             }
458            
459             elsif ($how eq "alt:") {
460             my $imgurl = $coll->item($n)->alt;
461             if ($regex_flag){
462             return $coll->item($n) if ($imgurl =~ $what);
463             }else{
464             return $coll->item($n) if ($imgurl eq $what);
465             }
466             }
467            
468             elsif ($how eq "beforetext:") {
469             $input = $coll->item($n) if ($coll->item($n)->tagname eq "INPUT");
470             my $text = $coll->item($n)->getAdjacentText("beforeEnd");
471             $text = trim_white_spaces($text);
472             if ($regex_flag){
473             return $input if ($text =~ $what);
474             }else{
475             return $input if ($text eq $what);
476             }
477             $text = $coll->item($n)->getAdjacentText("afterEnd");
478             $text = trim_white_spaces($text);
479             if ($regex_flag){
480             return $input if ($text =~ $what);
481             }else{
482             return $input if ($text eq $what);
483             }
484             }
485            
486             elsif ($how eq "aftertext:") {
487             undef $input;
488             $input = $coll->item($n) if (($coll->item($n)->tagName =~ m/^(INPUT|TEXTAREA)$/) && $coll->item($n)->type =~ m/^($type)$/);
489             #print $coll->item($n)->{type}."\n" if ($aftertext_flag == 1 && $input);
490             return $input if ($aftertext_flag == 1 && $input);
491             unless ($aftertext_flag){
492             my $text = $coll->item($n)->getAdjacentText("beforeEnd");
493             $text = trim_white_spaces($text);
494             if ($regex_flag){
495             $aftertext_flag = 1 if ($text =~ $what);
496             }else{
497             $aftertext_flag = 1 if ($text eq $what);
498             }
499             $text = $coll->item($n)->getAdjacentText("afterEnd");
500             $text = trim_white_spaces($text);
501             if ($regex_flag){
502             $aftertext_flag = 1 if ($text =~ $what);
503             }else{
504             $aftertext_flag = 1 if ($text eq $what);
505             }
506             }
507             }
508            
509             else{
510             print "WARNING: \'$how\' is not supported to get the object\n";
511             }
512            
513             }
514             }
515            
516             sub getFrame{
517             my ($self, $how, $what) = @_;
518             my $target_frame;
519             my $agent = $self->{agent};
520             my $frames = $agent->Document->frames;
521             $target_frame = __getObject($frames, $how, $what) if ($frames);
522             if ($target_frame){
523             my %frame = %{$self};
524             my $frameref = \%frame;
525             $frameref->{agent} = $target_frame;
526             bless $frameref;
527             return $frameref;
528             }else{
529             print "WARNING: No frame is present in the document with your specified option $how $what\n" if $warn;
530             }
531             }
532            
533             sub getPopupWindow{
534             my ($self, $what, $wait) = @_;
535             my $counter;
536             $wait = 2 unless $wait;
537             while($counter <= $wait ){
538             my $shApp = Win32::OLE->new("Shell.Application") || die "Could not start Shell.Application\n";
539             my $windows = $shApp->Windows;
540             for (my $n = 0; $n <= $windows->count - 1; $n++){
541             my $window = $windows->Item($n);
542             my $title = $window->document->title if $window;
543             if ($title eq $what){
544             my %popup = %{$self};
545             my $popupref = \%popup;
546             $popupref->{agent} = $window;
547             bless $popupref;
548             $popupref->WaitforDone;
549             return $popupref;
550             }
551             }
552             sleep 1;
553             $counter++
554             }
555             print "WARNING: No popup window is present with your specified title: $what\n" if $warn;
556             }
557            
558             sub WaitforDone{
559             my $self = shift;
560             my $agent = $self->{agent};
561             while ($agent->Busy || $agent->document->readystate ne "complete"){
562             sleep 1;
563             }
564             }
565            
566             sub WaitforDocumentComplete{
567             my $self = shift;
568             my $agent = $self->{agent};
569             while ($agent->document->readystate ne "complete"){
570             sleep 1;
571             }
572             }
573            
574             sub trim_white_spaces{
575             my $string = shift;
576             $string =~ s/^\s+//;
577             $string =~ s/\s+$//;
578             return $string;
579             }
580            
581             1;
582             __END__