t/Support/Integration.pm

   1 package Support::Integration;
   2
   3 use strict;
   4 use Exporter qw(import);
   5 use HTML::Query;
   6
   7 our @EXPORT = qw(make_request form_from_html);
   8
   9 package MockDispatcher {
  10   sub end_request { die "END_OF_MOCK_REQUEST" }
  11 };
  12
  13 sub setup {
  14   no warnings 'once';
  15   $::dispatcher = bless { }, "MockDispatcher";
  16 }
  17
  18 sub make_request {
  19   my ($controller, $action, %form_vars) = @_;
  20
  21   my ($out, $err, @ret);
  22
  23   package main {
  24     local $SIG{__WARN__} = sub {
  25       # ignore spurious warnings, TAP::Harness calls this warnings enabled
  26     };
  27
  28     open(my $out_fh, '>', \$out) or die;
  29     open(my $err_fh, '>', \$err) or die;
  30
  31     local *STDOUT = $out_fh;
  32     local *STDERR = $err_fh;
  33
  34     local $::form = Form->new;
  35     $::form->{$_} = $form_vars{$_} for keys %form_vars;
  36
  37     no strict "refs";
  38     eval {
  39       if ($controller =~ /^[a-z]/) {
  40         $::form->{script} = $controller.'.pl'; # usually set by dispatcher, needed for checks in update_exchangerate
  41         local $ENV{REQUEST_URI} = "http://localhost/$controller.pl"; # needed for Form::redirect_header
  42         require "bin/mozilla/$controller.pl";
  43         no warnings;
  44         @ret = &{ "::$action" }();
  45       } else {
  46         require "SL/Controller/$controller.pm";
  47         no warnings;
  48         @ret = "SL::Controller::$controller"->new->_run_action($action);
  49       }
  50       1;
  51     } or do { my $err = $@;
  52       die unless $err =~ /^END_OF_MOCK_REQUEST/;
  53       @ret = (1);
  54     }
  55   }
  56   return ($out, $err, @ret);
  57 }
  58
  59 sub form_from_html {
  60   my ($html, $form_selector) = @_;
  61   $form_selector //= '#form';
  62
  63   my $q = HTML::Query->new(text => $html);
  64
  65   my %form;
  66   for my $input ($q->query("$form_selector input")->get_elements()) {
  67     next if !$input->attr('name') || $input->attr('disabled');
  68     $form{ $input->attr('name') } = $input->attr('value') // "";
  69   }
  70   for my $select ($q->query("$form_selector select")->get_elements()) {
  71     my $name = $select->attr('name');
  72     my ($selected_option) = (
  73       grep({ $_->tag eq 'option' && $_->attr('selected') } $select->content_list),
  74       grep({ $_->tag eq 'option' } $select->content_list)
  75     );
  76
  77     $form{ $name } = $selected_option->attr('value') // $selected_option->as_text
  78       if $selected_option;
  79   }
  80
  81   %form;
  82 }
  83
  84 1;
  85
  86 __END__
  87
  88 =encoding utf-8
  89
  90 =head1 NAME
  91
  92 Support::Integration - helper for simple frontend integration tests
  93
  94 =head1 SYNOPSIS
  95
  96   # in tests
  97   use Support::Integration qw(:all);
  98
  99   # before making any requests, setup mock dispatcher
 100   Support::Integration::setup();
 101   Support::TestSetup::login();
 102
 103   # then do a simple request: ar.pl?action=add&type=invoice
 104   # returns the generated outputs and return values
 105   # exceptions are bubbled through
 106   my ($stdout, $strderr, @ret) = make_request('ar', 'add', type => 'invoice');
 107
 108   # generate form contents from html for the given form selector (defaults to '#form')
 109   my %form = form_from_html($stdout, '#form');
 110
 111   # add values the user would enter
 112   $form{partnumber} = "Part 1";
 113
 114   # there is no javascript emulation so you need to set ids like a picker would
 115   $form{customer_id} = 14392;
 116
 117   # and do request again
 118   ($stdout, $stderr, @ret) = make_request('ar', 'update', %form);
 119
 120   # also works with new controllers
 121   ($stdout, $stderr, @ret) = make_request('Part', 'new', %form);
 122
 123 =head1 DESCRIPTION
 124
 125 This is intended as a simple way of testing user centric journeys spanning
 126 multiple requests.
 127
 128 See synopsis for the intended usage. C<make_request> emulates most of the
 129 usual dispatching and routing and simply returns the html output of the action.
 130 C<form_from_html> extracts what would be submitted from a <form> element in the
 131 html.
 132
 133 =head1 FUNCTIONS
 134
 135 =over 4
 136
 137 =item * setup
 138
 139 Reigsters a mock dispatcher global so that C<$::dispatcher->end_request> works.
 140 Needs to be called before using L</make_request>
 141
 142 =item * make_request CONTROLLER, ACTION, [ FORM_KEY => FORM_VALUE, .... ]
 143
 144 Emulates a request. Supported are both old-style and new-style controllers.
 145 Since the routing code does not distinguish between verbs (GET/POST), this doesn't either.
 146
 147 Returns stdout, stderr and the return values of the action.
 148
 149 Exceptions are bubbled as is, with the exception of the graceful end_request.
 150
 151 =item * form_from_html HTML_STRING, [ FORM_SELECTOR ]
 152
 153 Parses the given html string into a dom, finds all inputs
 154 and selects within the given form selector
 155 and extracts their key values into a return hash.
 156
 157 If ommited, form selector defaults to C<#form>.
 158
 159 See L</CAVEATS> for limitations.
 160
 161 =back
 162
 163 =head1 CAVEATS
 164
 165 =over 4
 166
 167 =item * No authentication
 168
 169 This is not intended to emulate the login process. It is expected that
 170 C<Support::TestSetup::login()> is called for any Requests that require user access.
 171
 172 =item * No Javascript emulation
 173
 174 This means: no pickers, no auto format, no auto update on change.
 175 No dynamic content like added rows or autocompletion.
 176
 177 =item * Form extraction is stupid
 178
 179 This simply gets all non-disabled inputs and selects within a form selector.
 180 The order of elements is strictly DOM order, which is important for checkbox_for_submit
 181 and ParseFilter serialization.
 182
 183 =item * No network round-trips
 184
 185 Requests will be emulated within the same process without a network roundtrip.
 186 This is not for full black box system tests.
 187
 188 =item * Warnings are suppressed
 189
 190 Test::Harness will sometimes enable warnings for all code, which then pollutes
 191 stderr. so warnings are suppressed for make_request.
 192
 193 =back
 194
 195 =head1 AUTHOR
 196
 197 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 198
 199 =cut