FS/FS/Test.pm

   1 package FS::Test;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings FATAL => 'all';
   6
   7 use FS::UID qw(adminsuidsetup);
   8 use FS::Record;
   9 use URI;
  10 use URI::Escape;
  11 use Class::Accessor 'antlers';
  12 use Class::Load qw(load_class);
  13 use File::Spec;
  14 use HTML::Form;
  15
  16 our $VERSION = '0.03';
  17
  18 =head1 NAME
  19
  20 Freeside testing suite
  21
  22 =head1 SYNOPSIS
  23
  24   use Test::More 'tests' => 1;
  25   use FS::Test;
  26   my $FS = FS::Test->new;
  27   $FS->post('/edit/cust_main.cgi', ... ); # form fields
  28   ok( !$FS->error );
  29
  30 =head1 PROPERTIES
  31
  32 =over 4
  33
  34 =item page
  35
  36 The content of the most recent page fetched from the UI.
  37
  38 =item redirect
  39
  40 The redirect location (relative to the Freeside root) of the redirect
  41 returned from the UI, if there was one.
  42
  43 =head1 CLASS METHODS
  44
  45 =item new OPTIONS
  46
  47 Creates a test session. OPTIONS may contain:
  48
  49 - user: the Freeside test username [test]
  50 - base: the fake base URL for Mason to use [http://fake.freeside.biz]
  51
  52 =cut
  53
  54 has user      => ( is => 'rw' );
  55 has base      => ( is => 'ro' );
  56 has fs_interp => ( is => 'rw' );
  57 has path      => ( is => 'rw' );
  58 has page      => ( is => 'ro' );
  59 has error     => ( is => 'rw' );
  60 has dbh       => ( is => 'rw' );
  61 has redirect  => ( is => 'rw' );
  62
  63 sub new {
  64   my $class = shift;
  65   my $self = {
  66     user  => 'test',
  67     page  => '',
  68     error => '',
  69     base  => 'http://fake.freeside.biz',
  70     @_
  71   };
  72   $self->{base} = URI->new($self->{base});
  73   bless $self;
  74
  75   adminsuidsetup($self->user);
  76   load_class('FS::Mason');
  77   $self->dbh( FS::UID::dbh() );
  78
  79   my ($fs_interp) = FS::Mason::mason_interps('standalone',
  80     outbuf => \($self->{page})
  81   );
  82   $fs_interp->error_mode('fatal');
  83   $fs_interp->error_format('brief');
  84
  85   $self->fs_interp( $fs_interp );
  86
  87   RT::LoadConfig();
  88   RT::Init();
  89
  90   return $self;
  91 }
  92
  93 =back
  94
  95 =head1 METHODS
  96
  97 =over 4
  98
  99 =item post PATH, PARAMS
 100
 101 =item post FORM
 102
 103 Submits a request to PATH, through the Mason UI, with arguments in PARAMS.
 104 This will be converted to a URL query string. Anything returned by the UI
 105 will be in the C<page()> property.
 106
 107 Alternatively, takes an L<HTML::Form> object (with fields filled in, via
 108 the C<param()> method) and submits it.
 109
 110 =cut
 111
 112 sub post {
 113   my $self = shift;
 114
 115   # shut up, CGI
 116   local $CGI::LIST_CONTEXT_WARN = 0;
 117
 118   my ($path, $query);
 119   if ( UNIVERSAL::isa($_[0], 'HTML::Form') ) {
 120     my $form = shift;
 121     my $request = $form->make_request;
 122     $path = $request->uri->path;
 123     $query = $request->content;
 124   } else {
 125     $path = shift;
 126     my @params = @_;
 127     if (scalar(@params) == 0) {
 128       # possibly path?query syntax, or else no query string at all
 129       ($path, $query) = split('\?', $path);
 130     } elsif (scalar(@params) == 1) {
 131       $query = uri_escape($params[0]); # keyword style
 132     } else {
 133       while (@params) {
 134         $query .= uri_escape(shift @params) . '=' .
 135                   uri_escape(shift @params);
 136         $query .= ';' if @params;
 137       }
 138     }
 139   }
 140   # remember which page this is
 141   $self->path($path);
 142
 143   local $FS::Mason::Request::FSURL = $self->base->as_string;
 144   local $FS::Mason::Request::QUERY_STRING = $query;
 145   # because we're going to construct an actual CGI object in here
 146   local $ENV{SERVER_NAME} = $self->base->host;
 147   local $ENV{SCRIPT_NAME} = $self->base->path . $path;
 148   local $@ = '';
 149   my $mason_request = $self->fs_interp->make_request(comp => $path);
 150   eval {
 151     $mason_request->exec();
 152   };
 153
 154   if ( $@ ) {
 155     if ( ref $@ eq 'HTML::Mason::Exception' ) {
 156       $self->error($@->message);
 157     } else {
 158       $self->error($@);
 159     }
 160   } elsif ( $mason_request->notes('error') ) {
 161     $self->error($mason_request->notes('error'));
 162   } else {
 163     $self->error('');
 164   }
 165
 166   if ( my $loc = $mason_request->redirect ) {
 167     my $base = $self->base->as_string;
 168     $loc =~ s/^$base//;
 169     $self->redirect($loc);
 170   } else {
 171     $self->redirect('');
 172   }
 173   ''; # return error? HTTP status? something?
 174 }
 175
 176 =item proceed
 177
 178 If the last request returned a redirect, follow it.
 179
 180 =cut
 181
 182 sub proceed {
 183   my $self = shift;
 184   if ($self->redirect) {
 185     $self->post($self->redirect);
 186   }
 187   # else do nothing
 188 }
 189
 190 =item forms
 191
 192 For the most recently returned page, returns a list of L<HTML::Form>s found.
 193
 194 =cut
 195
 196 sub forms {
 197   my $self = shift;
 198   my $formbase = $self->base->as_string . $self->path;
 199   return HTML::Form->parse( $self->page, base => $formbase );
 200 }
 201
 202 =item form NAME
 203
 204 For the most recently returned page, returns an L<HTML::Form> object
 205 representing the form named NAME. You can then call methods like
 206 C<value(inputname, inputvalue)> to set the values of inputs on the form,
 207 and then pass the form object to L</post> to submit it.
 208
 209 =cut
 210
 211 sub form {
 212   my $self = shift;
 213   my $name = shift;
 214   my ($form) = grep { $_->attr('name') eq $name } $self->forms;
 215   $form;
 216 }
 217
 218 =item qsearch ARGUMENTS
 219
 220 Searches the database, like L<FS::Record::qsearch>.
 221
 222 =item qsearchs ARGUMENTS
 223
 224 Searches the database for a single record, like L<FS::Record::qsearchs>.
 225
 226 =cut
 227
 228 sub qsearch {
 229   my $self = shift;
 230   FS::Record::qsearch(@_);
 231 }
 232
 233 sub qsearchs {
 234   my $self = shift;
 235   FS::Record::qsearchs(@_);
 236 }
 237
 238 1; # End of FS::Test