File Coverage

blib/lib/Test/WWW/Selenium/Conversion/IDE.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

#########
# Author:        Andy Brown ([e-mail])
package Test::WWW::Selenium::Conversion::IDE;

use strict;
use warnings;
use Carp;
use English q{-no_match_vars};
use Test::More; # this is designed to be a helper for tests, OK
use Test::WWW::Selenium; # we are going to run the tests in this
use XML::LibXML;
use base q{Exporter};
use Readonly; Readonly::Scalar our $VERSION => 0.5;

our @EXPORT = qw{ ide_to_TWS_run_from_suite_file ide_to_TWS_run_from_test_file };

Readonly::Scalar our $DEFAULT_TIMEOUT => 50_000;
Readonly::Scalar our $DEFAULT_SELENIUM_LOCATION => q{t/selenium_tests};
Readonly::Scalar our $MAX_TIMES_TO_LOOP => 20;

sub ide_to_TWS_run_from_suite_file {
  my ( $sel, $suite_file, $sel_test_root ) = @_;
  $sel_test_root ||= $DEFAULT_SELENIUM_LOCATION;

  my $parser = XML::LibXML->new();
  my $suite = $parser->parse_html_file( qq{$sel_test_root/$suite_file} );
  my @tests = $suite->getElementsByTagName( q{a} );
  foreach my $test ( @tests ) {
    my $test_file = $test->getAttribute( q{href} );
    $test_file =~ s{[.]/}{}xms;
    ide_to_TWS_run_from_test_file( $sel, {
      test_file => $test_file,
      sel_test_root => $sel_test_root,
      parser => $parser,
    } );
  }
  return 1;
}

sub ide_to_TWS_run_from_test_file {
  my ( $sel, $args ) = @_;
  my $test_file = $args->{test_file};
  my $sel_test_root = $args->{sel_test_root} || $DEFAULT_SELENIUM_LOCATION;
  my $parser = $args->{parser} || XML::LibXML->new();

  my $test_dom = $parser->parse_html_file( qq{$sel_test_root/$test_file} );
  my @title_tags = $test_dom->getElementsByTagName( q{title} );
  my $title = $title_tags[0]->firstChild->nodeValue();
  note qq{Running Selenium Test: '$title'};

  my ($tbody) = $test_dom->getElementsByTagName( q{tbody} );
  foreach my $action_set ( $tbody->getElementsByTagName( q{tr} ) ) {
    my ( $action, $operand_1, $operand_2 ) = $action_set->getElementsByTagName( q{td} );
    foreach my $node ( $action, $operand_1, $operand_2 ) {
      if ( defined $node && defined $node->firstChild ) {
        $node = $node->firstChild->nodeValue();
      } else {
        $node = q{};
      }
    }
    if ( $operand_1 =~ m{\A[(]?//}xms ) {
      $operand_1 = q{xpath=} . $operand_1;
    }
    my $test_args = {
      action => $action,
      operand_1 => $operand_1,
      operand_2 => $operand_2,
    };
    _ide_to_TWS_convert_to_method_and_test( $sel, $test_args);
  }
  return 1;
}

sub _ide_to_TWS_convert_to_method_and_test {
  my ( $sel, $args ) = @_;

  my %actions = (
    open => \&_ide_to_TWS_open_test,
    verifyTitle => \&_ide_to_TWS_verifyTitle_test,
    verifyText => \&_ide_to_TWS_verifyTextPresent_test,
    verifyTextPresent => \&_ide_to_TWS_verifyTextPresent_test,
    assertText => \&_ide_to_TWS_verifyTextPresent_test,
    assertTextPresent => \&_ide_to_TWS_verifyTextPresent_test,
    waitForElementPresent => \&_ide_to_TWS_waitForText,
    assertElementPresent => \&_ide_to_TWS_verifyTextPresent_test,
    clickAndWait => \&_ide_to_TWS_clickAndWait,
    click => \&_ide_to_TWS_clickAndWait,
    type => \&_ide_to_TWS_type,
    waitForText => \&_ide_to_TWS_waitForText,
    select => \&_ide_to_TWS_select,
    selectAndWait => \&_ide_to_TWS_select,
    random_alert => \&_ide_to_TWS_random_alert,
  );
  eval {
   $actions{$args->{action}}( $sel, $args );
   1;
  } or do {
    diag explain $args;
    diag qq{\t$EVAL_ERROR};
  };
  return;
}

sub _ide_to_TWS_random_alert {
  my ( $sel, $args ) = @_;
  my $alert_present = $sel->is_alert_present;
  my $msg = q{Random alert } . ( $alert_present ? q{} : q{not } ) . q{found} . ( $alert_present ? q{ } . $sel->get_alert : q{} );
  pass($msg);
  return;
}

sub _ide_to_TWS_select {
  my ( $sel, $args ) = @_;
  ok( $sel->select($args->{operand_1}, $args->{operand_2}), , qq{select $args->{operand_2} from $args->{operand_1}} );
  return;
}

sub _ide_to_TWS_verifyTitle_test {
  my ( $sel, $args ) = @_;
  is( $sel->get_title(), $args->{operand_1}, qq{Title is $args->{operand_1}} );
  return;
}

sub _ide_to_TWS_waitForText {
  my ( $sel, $args ) = @_;
  my $op1 = $args->{operand_1};
  my $op2 = $args->{operand_2};
  if ( $op1 && $op2 ) {
    note qq{waiting for text $op2 in $op1};
    my $found = 0;
    my $count = 1;
    while ( ! $found && $count < $MAX_TIMES_TO_LOOP ) {
      $count++;
      eval {
        my $text = $sel->get_text( $op1 );
        if ( $op2 =~ m/regexp/ixms ) {
          my ( $type, $expression ) = $op2 =~ m/(regexp[i]?):(.*)/ixms;
          if ( $type =~ /i/ixms ) {
            if ( $text =~ m/$expression/ixms ) {
              $found++;
            }
          } else {
            if ( $text =~ m/$expression/xms ) {
              $found++;
            }
          }
        } else {
          if ( $text eq $op2 ) {
            $found++;
          }
        }
      } or do {};
      if ( ! $found ) {
        sleep 1;
      }
    }
    $count = $count < $MAX_TIMES_TO_LOOP ? $count : $MAX_TIMES_TO_LOOP;
    ok( $found, qq{waiting for text $op2 in $op1 - tried $count times} );
  } else {
    note qq{waiting for text $op1};
    if ( $op1 =~ m/[id|identifier|css]=/xms ) {
      ok( $sel->wait_for_element_present( $op1, $DEFAULT_TIMEOUT ), qq{waiting for text $op1} );
    } else {
      ok( $sel->wait_for_text_present( $op1, $DEFAULT_TIMEOUT ), qq{waiting for text $op1} );
    }
  }
  return;
}

sub _ide_to_TWS_type {
  my ( $sel, $args ) = @_;
  note qq{typing $args->{operand_2} into $args->{operand_1}};
  $sel->type( $args->{operand_1}, $args->{operand_2} );
  return;
}

sub _ide_to_TWS_clickAndWait {
  my ( $sel, $args ) = @_;
  my $msg = qq{clicking $args->{operand_1}};
  note $msg;
  my $result;
  my $payload;
  eval { $sel->click($args->{operand_1}); $result = 1; } or do { $result = 0; $payload = $EVAL_ERROR; };
  ok( $result, $msg );
  if ( ! $result ) {
    diag $payload;
  }
  if ( $args->{action} ne q{click} ) {
    $msg = q{waiting for page to load};
    note $msg;
    if ( ! $result ) {
      ok( 0, $msg ); # auto fail if click failed
    } else {
      ok( $sel->wait_for_page_to_load( $DEFAULT_TIMEOUT ), $msg );
    }
  }
  return;
}

sub _ide_to_TWS_verifyTextPresent_test {
  my ( $sel, $args ) = @_;
  my $text1 = $args->{operand_1};
  my $text2 = $args->{operand_2};
  if ( $text2 ) {
    if ( $text1) {
      ok( $sel->is_element_present($text1), qq{element $text1 present on page} );
      if ( $text2 !~ m/\A[[:lower:]]+:/ixms || $text2 =~ m/\Aexact:/ixms ) {
        $text2 =~ s/exact://ixms;
        is( $sel->get_text($text1), $text2, qq{element $text1 has text of $text2} );
      }
    }
  } else {
    if ( $text1 =~ m/=/xms ) {
      ok( $sel->is_element_present($text1), qq{element $text1 present on page} );
    } else {
      like( $sel->get_body_text, qr{$text1}, qq{body text contains $text1} ); ## no critic (RegularExpressions::RequireDotMatchAnything RegularExpressions::RequireExtendedFormatting RegularExpressions::RequireLineBoundaryMatching)
    }
  }
  return;
}

sub _ide_to_TWS_open_test {
  my ( $sel, $args ) = @_;
  my $page = $args->{operand_1};
  $sel->open_ok( $page, undef, qq{open page $page} );
  return
}

1;
__END__