summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/Mason/StandaloneRequest.pm9
-rw-r--r--FS/FS/Test.pm238
-rwxr-xr-xFS/t/suite/00-new_customer.t67
-rwxr-xr-xFS/t/suite/01-order_pkg.t49
-rwxr-xr-xFS/t/suite/02-bill_customer.t36
-rwxr-xr-xFS/t/suite/03-realtime_pay.t40
-rw-r--r--FS/t/suite/WRITING93
7 files changed, 532 insertions, 0 deletions
diff --git a/FS/FS/Mason/StandaloneRequest.pm b/FS/FS/Mason/StandaloneRequest.pm
index a5e4dcb2a..e34a35310 100644
--- a/FS/FS/Mason/StandaloneRequest.pm
+++ b/FS/FS/Mason/StandaloneRequest.pm
@@ -20,4 +20,13 @@ sub new {
}
+# fake this up for UI testing
+sub redirect {
+ my $self = shift;
+ if (scalar(@_)) {
+ $self->{_redirect} = shift;
+ }
+ return $self->{_redirect};
+}
+
1;
diff --git a/FS/FS/Test.pm b/FS/FS/Test.pm
new file mode 100644
index 000000000..9854b94fa
--- /dev/null
+++ b/FS/FS/Test.pm
@@ -0,0 +1,238 @@
+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<page()> property.
+
+Alternatively, takes an L<HTML::Form> object (with fields filled in, via
+the C<param()> 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 L<HTML::Form>s 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<HTML::Form> object
+representing the form named NAME. You can then call methods like
+C<value(inputname, inputvalue)> to set the values of inputs on the form,
+and then pass the form object to L</post> 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<FS::Record::qsearch>.
+
+=item qsearchs ARGUMENTS
+
+Searches the database for a single record, like L<FS::Record::qsearchs>.
+
+=cut
+
+sub qsearch {
+ my $self = shift;
+ FS::Record::qsearch(@_);
+}
+
+sub qsearchs {
+ my $self = shift;
+ FS::Record::qsearchs(@_);
+}
+
+1; # End of FS::Test
diff --git a/FS/t/suite/00-new_customer.t b/FS/t/suite/00-new_customer.t
new file mode 100755
index 000000000..8e86459d1
--- /dev/null
+++ b/FS/t/suite/00-new_customer.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+use FS::Test;
+use Test::More tests => 4;
+
+my $FS = FS::Test->new;
+# get the form
+$FS->post('/edit/cust_main.cgi');
+my $form = $FS->form('CustomerForm');
+
+my %params = (
+ residential_commercial => 'Residential',
+ agentnum => 1,
+ refnum => 1,
+ last => 'Customer',
+ first => 'New',
+ invoice_email => 'newcustomer@fake.freeside.biz',
+ bill_address1 => '123 Example Street',
+ bill_address2 => 'Apt. Z',
+ bill_city => 'Sacramento',
+ bill_state => 'CA',
+ bill_zip => '94901',
+ bill_country => 'US',
+ bill_coord_auto => 'Y',
+ daytime => '916-555-0100',
+ night => '916-555-0200',
+ ship_address1 => '125 Example Street',
+ ship_address2 => '3rd Floor',
+ ship_city => 'Sacramento',
+ ship_state => 'CA',
+ ship_zip => '94901',
+ ship_country => 'US',
+ ship_coord_auto => 'Y',
+ invoice_ship_address => 'Y',
+ postal_invoice => 'Y',
+ billday => '1',
+ no_credit_limit => 1,
+ # payment method
+ custpaybynum0_payby => 'CARD',
+ custpaybynum0_payinfo => '4012888888881881',
+ custpaybynum0_paydate_month => '12',
+ custpaybynum0_paydate_year => '2020',
+ custpaybynum0_paycvv => '123',
+ custpaybynum0_payname => '',
+ custpaybynum0_weight => 1,
+);
+foreach (keys %params) {
+ $form->value($_, $params{$_});
+}
+$FS->post($form);
+ok( $FS->error eq '' , 'form posted' );
+if (
+ ok($FS->redirect =~ m[^/view/cust_main.cgi\?(\d+)], 'new customer accepted')
+) {
+ my $custnum = $1;
+ my $cust = $FS->qsearchs('cust_main', { custnum => $1 });
+ isa_ok ( $cust, 'FS::cust_main' );
+ $FS->post($FS->redirect);
+ ok ( $FS->error eq '' , 'can view customer' );
+} else {
+ # try to display the error message, or if not, show everything
+ $FS->post($FS->redirect);
+ diag ($FS->error);
+ done_testing(2);
+}
+
+1;
diff --git a/FS/t/suite/01-order_pkg.t b/FS/t/suite/01-order_pkg.t
new file mode 100755
index 000000000..1511350c4
--- /dev/null
+++ b/FS/t/suite/01-order_pkg.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use Test::More tests => 4;
+use FS::Test;
+use Date::Parse 'str2time';
+my $FS = FS::Test->new;
+
+# get the form
+$FS->post('/misc/order_pkg.html', custnum => 2);
+my $form = $FS->form('OrderPkgForm');
+
+# Customer #2 has three packages:
+# a $30 monthly prorate, a $90 monthly prorate, and a $25 annual prorate.
+# Next bill date on the monthly prorates is 2016-04-01.
+# Add a new package that will start billing on 2016-03-20 (to make prorate
+# behavior visible).
+
+my %params = (
+ pkgpart => 5,
+ quantity => 1,
+ start => 'on_date',
+ start_date => '03/20/2016',
+ package_comment0 => $0, # record the test we're executing
+);
+
+$form->find_input('start')->disabled(0); # JS
+foreach (keys %params) {
+ $form->value($_, $params{$_});
+}
+$FS->post($form);
+ok( $FS->error eq '' , 'form posted' );
+if (
+ ok( $FS->page =~ m[location = '.*/view/cust_main.cgi.*\#cust_pkg(\d+)'],
+ 'new package accepted' )
+) {
+ # on success, sends us back to cust_main view with #cust_pkg$pkgnum
+ # but with an in-page javascript redirect
+ my $pkg = $FS->qsearchs('cust_pkg', { pkgnum => $1 });
+ isa_ok( $pkg, 'FS::cust_pkg' );
+ ok($pkg->start_date == str2time('2016-03-20'), 'start date set');
+} else {
+ # try to display the error message, or if not, show everything
+ $FS->post($FS->redirect);
+ diag ($FS->error);
+ done_testing(2);
+}
+
+1;
+
diff --git a/FS/t/suite/02-bill_customer.t b/FS/t/suite/02-bill_customer.t
new file mode 100755
index 000000000..0afffaa70
--- /dev/null
+++ b/FS/t/suite/02-bill_customer.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use FS::Test;
+use Test::More tests => 6;
+use Test::MockTime 'set_fixed_time';
+use Date::Parse 'str2time';
+use FS::cust_main;
+
+my $FS = FS::Test->new;
+
+# After test 01: cust#2 has a package set to bill on 2016-03-20.
+# Set local time.
+my $date = '2016-03-20';
+set_fixed_time(str2time($date));
+my $cust_main = FS::cust_main->by_key(2);
+my @return;
+
+# Bill the customer.
+my $error = $cust_main->bill( return_bill => \@return );
+ok($error eq '', "billed on $date") or diag($error);
+
+# should be an invoice now
+my $cust_bill = $return[0];
+isa_ok($cust_bill, 'FS::cust_bill');
+
+# $60/month * (30 days - 19 days)/30 days = $42
+ok( $cust_bill->charged == 42.00, 'prorated first month correctly' );
+
+# the package bill date should now be 2016-04-01
+my @lineitems = $cust_bill->cust_bill_pkg;
+ok( scalar(@lineitems) == 1, 'one package was billed' );
+my $pkg = $lineitems[0]->cust_pkg;
+ok( $pkg->status eq 'active', 'package is now active' );
+ok( $pkg->bill == str2time('2016-04-01'), 'package bill date set correctly' );
+
+1;
diff --git a/FS/t/suite/03-realtime_pay.t b/FS/t/suite/03-realtime_pay.t
new file mode 100755
index 000000000..17456bb15
--- /dev/null
+++ b/FS/t/suite/03-realtime_pay.t
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+use FS::Test;
+use Test::More tests => 2;
+use FS::cust_main;
+
+my $FS = FS::Test->new;
+
+# In the stock database, cust#5 has open invoices
+my $cust_main = FS::cust_main->by_key(5);
+my $balance = $cust_main->balance;
+ok( $balance > 10.00, 'customer has an outstanding balance of more than $10.00' );
+
+# Get the payment form
+$FS->post('/misc/payment.cgi?payby=CARD;custnum=5');
+my $form = $FS->form('OneTrueForm');
+$form->value('amount' => '10.00');
+$form->value('custpaybynum' => '');
+$form->value('payinfo' => '4012888888881881');
+$form->value('month' => '01');
+$form->value('year' => '2020');
+# payname and location fields should already be set
+$form->value('save' => 1);
+$form->value('auto' => 1);
+$FS->post($form);
+
+# on success, gives a redirect to the payment receipt
+my $paynum;
+if ($FS->redirect =~ m[^/view/cust_pay.html\?(\d+)]) {
+ pass('payment processed');
+ $paynum = $1;
+} elsif ( $FS->error ) {
+ fail('payment rejected');
+ diag ( $FS->error );
+} else {
+ fail('unknown result');
+ diag ( $FS->page );
+}
+
+1;
diff --git a/FS/t/suite/WRITING b/FS/t/suite/WRITING
new file mode 100644
index 000000000..d9421cc7b
--- /dev/null
+++ b/FS/t/suite/WRITING
@@ -0,0 +1,93 @@
+WRITING TESTS
+
+Load the test database (kept in FS-Test/share/test.sql for now). This has
+a large set of customers in a known initial state. You can login through
+the web interface as "admin"/"admin" to examine the state of things and plan
+your test.
+
+The test scripts now have access to BOTH sides of the web interface, so you
+can create an object through the UI and then examine its internal
+properties, etc.
+
+ use Test::More tests => 1;
+ use FS::Test;
+ my $FS = FS::Test->new;
+
+$FS has qsearch and qsearchs methods for finding objects directly. You can
+do anything with those objects that Freeside backend code could normally do.
+For example, this will bill a customer:
+
+ my $cust = $FS->qsearchs('cust_main', { custnum => 52 });
+ my $error = $cust->bill;
+
+TESTING UI INTERACTION
+
+To fetch a page from the UI, use the post() method:
+
+ $FS->post('/view/cust_main.cgi?52');
+ ok( $FS->error eq '', 'fetched customer view' ) or diag($FS->error);
+ ok( $FS->page =~ /Customer, New/, 'customer is named "Customer, New"' );
+
+To simulate a user filling in and submitting a form, first fetch the form,
+and select it by name:
+
+ $FS->post('/edit/svc_acct.cgi?98');
+ my $form = $FS->form('OneTrueForm');
+
+then fill it in and submit it:
+
+ $form->value('clear_password', '1234abcd');
+ $FS->post($form);
+
+and examine the result:
+
+ my $svc_acct = $FS->qsearch('svc_acct', { svcnum => 98 });
+ ok( $svc_acct->_password eq '1234abcd', 'password was changed' );
+
+TESTING UI FLOW (EDIT/PROCESS/VIEW SEQUENCE)
+
+Forms for editing records will post to a processing page. $FS->post($form)
+handles this. The processing page will usually redirect back to the view
+page on success, and back to the edit form with an error on failure.
+Determine which kind of redirect it is. If it's a redirect to the edit form,
+you need to follow it to report the error.
+
+ if ( $FS->redirect =~ m[^/view/svc_acct.cgi] ) {
+
+ pass('redirected to view page');
+
+ } elsif ( $FS->redirect =~ m[^/edit/svc_acct.cgi] ) {
+
+ fail('redirected back to edit form');
+ $FS->post($FS->redirect);
+ diag($FS->error);
+
+ } else {
+
+ fail('unsure what happened');
+ diag($FS->page);
+
+ }
+
+RUNNING TESTS AT A SPECIFIC DATE
+
+Important for testing package billing. Test::MockTime provides the
+set_fixed_time() function, which will freeze the time returned by the time()
+function at a specific value. I recommend giving it a unix timestamp rather
+than a date string to avoid any confusion about time zones.
+
+Note that FS::Cron::bill and some other parts of the system look at the $^T
+variable (the time that the current program started running). You can
+override that by just assigning to the variable.
+
+Customers in the test database are billed up through Mar 1 2016. This will
+bill a customer for the next month after that:
+
+ use Test::MockTime qw(set_fixed_time);
+ use Date::Parse qw(str2time);
+
+ my $cust = $FS->qsearchs('cust_main', { custnum => 52 });
+ set_fixed_time( str2time('2016-04-01') );
+ $cust->bill;
+
+
generated by cgit v1.2.1 (git 2.18.0) at 2025-07-06 18:40:48 +0000