view release on metacpan or  search on metacpan

lib/App/SimpleScan.pm  view on Meta::CPAN

            $self->_substitution_data($var, @data);
          }
          else {
            my @items = split $message;
            my $between = (@items < 3) ? 'between' : 'among';
            $self->stack_test( qw(fail "Cannot add substitution for $var: dependency loop $between $message";\n));
          }
        }
      }
      next;
    };

    # Commit any substitutions.
    # We use 'next' because the substituted lines
    # will have been queued on the input if there
    # where any substitutions.
    #
    # We do this *after* pragma processing because
    # if we have this:
    #  %%foo bar baz
    #  %%quux <foo> is the value
    #
    # and we expanded pragmas in place, we'd get
    #  %%foo bar baz
    #  %%quux bar
    #  %%quux baz
    #
    # which is probably *not* what is wanted.
    # Putting this here makes sure that we only
    # substitute into actual test specs.
    next if $self->_queue_substituted_lines($_);

    # No substitutions in this line, so just process it.
    my $item = App::SimpleScan::TestSpec->new($_);

    # Store it in case a plugin needs to look at the
    # test spec in an overriding method.
    $self->set_current_spec($item);

    if ($item->syntax_error) {
      $self->stack_code(<<"END_MSG");
# @{[$item->raw]}
# Possible syntax error in this test spec
END_MSG
    }
    else {
      $item->as_tests;
      local $_ = $item ->raw;                           ##no critic
      s/\n//mx;
    }
    # Drop the spec (there isn't one active now).
    $self->set_current_spec();
  }
  return;
}

# Calls each plugin's test_modules method
# to stack any other test modules needed to
# properly handle the test code. (Plugins may
# want to generate test code that needs
# something like Test::Differences, etc. -
# this lets them load that module so the
# tests actually work.)
#
# Also adds the test plan.
#
# Finally, initializes the user agent (unless
# we're specifically directed *not* to do so).
sub finalize_tests {
  my ($self) = @_;
  my @tests = @{$self->tests};
  my @prepends;
  foreach my $plugin (__PACKAGE__->plugins) {
    if ($plugin->can('test_modules')) {
      foreach my $module ($plugin->test_modules) {
        push @prepends, "use $module;\n";
      }
    }
  }
  # Handle conditional user agent initialization.
  # This was added because some servers (e.g., WAP
  # servers) refuse connections from known user agents,
  # but others (e.g., Yahoo!'s web servers) refuse
  # login attempts from non-browser user agents.
  #
  # Set the user agent unless --no-agent was given.

  if (!$self->no_agent) {
    push @prepends, qq(mech->agent_alias("Windows IE 6");\n);
  }

  # Add the boilerplate testing stuff.
  unshift @prepends,
    (
      "use Test::More tests=>@{[$self->test_count]};\n",
      "use Test::WWW::Simple;\n",
      "use strict;\n",
      "\n",
    );


  $self->tests( [ @prepends, @tests ] );
  return;
}

#######################
# External utility methods.

# Handle backticked values in substitutions.
sub expand_backticked {
  use re 'eval';

  my ($self, $text) = @_;

  # The state machine was a really cool idea, except it didn't work. :-P
  # A little reading in Mastering Regular Expressions gave me the patterns
  # shown below for matching quoted strings.

  # For an explanation of why this works, see Friedl, p. 262 ff.
  # It's called "unrolling" the regex there.