package FS::Test; use 5.006; use strict; use warnings FATAL => 'all'; use FS::UID qw(adminsuidsetup); use FS::Record; use URI; use URI::Escape; use Class::Accessor 'antlers'; use Class::Load qw(load_class); use File::Spec; use HTML::Form; our $VERSION = '0.03'; =head1 NAME Freeside testing suite =head1 SYNOPSIS use Test::More 'tests' => 1; use FS::Test; my $FS = FS::Test->new; $FS->post('/edit/cust_main.cgi', ... ); # form fields ok( !$FS->error ); =head1 PROPERTIES =over 4 =item page The content of the most recent page fetched from the UI. =item redirect The redirect location (relative to the Freeside root) of the redirect returned from the UI, if there was one. =head1 CLASS METHODS =item new OPTIONS Creates a test session. OPTIONS may contain: - user: the Freeside test username [test] - base: the fake base URL for Mason to use [http://fake.freeside.biz] =cut has user => ( is => 'rw' ); has base => ( is => 'ro' ); has fs_interp => ( is => 'rw' ); has path => ( is => 'rw' ); has page => ( is => 'ro' ); has error => ( is => 'rw' ); has dbh => ( is => 'rw' ); has redirect => ( is => 'rw' ); sub new { my $class = shift; my $self = { user => 'test', page => '', error => '', base => 'http://fake.freeside.biz', @_ }; $self->{base} = URI->new($self->{base}); bless $self; adminsuidsetup($self->user); load_class('FS::Mason'); $self->dbh( FS::UID::dbh() ); my ($fs_interp) = FS::Mason::mason_interps('standalone', outbuf => \($self->{page}) ); $fs_interp->error_mode('fatal'); $fs_interp->error_format('brief'); $self->fs_interp( $fs_interp ); RT::LoadConfig(); RT::Init(); return $self; } =back =head1 METHODS =over 4 =item post PATH, PARAMS =item post FORM Submits a request to PATH, through the Mason UI, with arguments in PARAMS. This will be converted to a URL query string. Anything returned by the UI will be in the C property. Alternatively, takes an L object (with fields filled in, via the C method) and submits it. =cut sub post { my $self = shift; # shut up, CGI local $CGI::LIST_CONTEXT_WARN = 0; my ($path, $query); if ( UNIVERSAL::isa($_[0], 'HTML::Form') ) { my $form = shift; my $request = $form->make_request; $path = $request->uri->path; $query = $request->content; } else { $path = shift; my @params = @_; if (scalar(@params) == 0) { # possibly path?query syntax, or else no query string at all ($path, $query) = split('\?', $path); } elsif (scalar(@params) == 1) { $query = uri_escape($params[0]); # keyword style } else { while (@params) { $query .= uri_escape(shift @params) . '=' . uri_escape(shift @params); $query .= ';' if @params; } } } # remember which page this is $self->path($path); local $FS::Mason::Request::FSURL = $self->base->as_string; local $FS::Mason::Request::QUERY_STRING = $query; # because we're going to construct an actual CGI object in here local $ENV{SERVER_NAME} = $self->base->host; local $ENV{SCRIPT_NAME} = $self->base->path . $path; local $@ = ''; my $mason_request = $self->fs_interp->make_request(comp => $path); eval { $mason_request->exec(); }; if ( $@ ) { if ( ref $@ eq 'HTML::Mason::Exception' ) { $self->error($@->message); } else { $self->error($@); } } elsif ( $mason_request->notes('error') ) { $self->error($mason_request->notes('error')); } else { $self->error(''); } if ( my $loc = $mason_request->redirect ) { my $base = $self->base->as_string; $loc =~ s/^$base//; $self->redirect($loc); } else { $self->redirect(''); } ''; # return error? HTTP status? something? } =item proceed If the last request returned a redirect, follow it. =cut sub proceed { my $self = shift; if ($self->redirect) { $self->post($self->redirect); } # else do nothing } =item forms For the most recently returned page, returns a list of Ls found. =cut sub forms { my $self = shift; my $formbase = $self->base->as_string . $self->path; return HTML::Form->parse( $self->page, base => $formbase ); } =item form NAME For the most recently returned page, returns an L object representing the form named NAME. You can then call methods like C to set the values of inputs on the form, and then pass the form object to L to submit it. =cut sub form { my $self = shift; my $name = shift; my ($form) = grep { ($_->attr('name') || '') eq $name } $self->forms; $form; } =item qsearch ARGUMENTS Searches the database, like L. =item qsearchs ARGUMENTS Searches the database for a single record, like L. =cut sub qsearch { my $self = shift; FS::Record::qsearch(@_); } sub qsearchs { my $self = shift; FS::Record::qsearchs(@_); } =item new_customer FIRSTNAME Returns an L object full of default test data, ready to be inserted. This doesn't insert the customer, because you might want to change some things first. FIRSTNAME is recommended so you know which test the customer was used for. =cut sub new_customer { my $self = shift; my $first = shift || 'No Name'; my $location = FS::cust_location->new({ address1 => '123 Example Street', city => 'Sacramento', state => 'CA', country => 'US', zip => '94901', }); my $cust = FS::cust_main->new({ agentnum => 1, refnum => 1, last => 'Customer', first => $first, invoice_email => 'newcustomer@fake.freeside.biz', bill_location => $location, ship_location => $location, }); $cust; } 1; # End of FS::Test