use Test::More;
use Getopt::Std;
use Modern::Perl;
use Data::Printer;
use Test::Exception;
use AdvancedShop;
use MaleCustomer;
use FemaleCustomer;
use vars qw(%opts);
getopts('p:', \%opts); # probability
my $p = $opts{p} || 0.03;
{ # male customer, tolerance in range:
my $male = MaleCustomer->new( tolerance => 45 ); # limits 30 .. 90
is ($male->wait, 45, 'male customer tolerance value between limits');
is ($male->getPayment, 12, 'returned expected male customer cost value');
is ($male->getRequiredTime, 15, 'returned expected male customer requiredTime value');
}
{ # female customer, requiredTime in range:
my $female = FemaleCustomer->new( requiredTime => 25 ); # limits 20 .. 50
is ($female->getRequiredTime, 25, 'female customer requiredTime value between limits');
is ($female->getPayment, 25, 'returned expected female customer cost value');
is ($female->wait, 120, 'returned expected female customer tolerance value');
}
{ # male customer, tolerance out of range:
throws_ok { MaleCustomer->new( tolerance => 95 ) } # limits 30 .. 90
qr/isa check for "tolerance" failed/,
'male customer tolerance value out of limits';
}
{ # female customer, requiredTime out of range:
throws_ok { FemaleCustomer->new( requiredTime => 55 ) } # limits 20 .. 50
qr/isa check for "requiredTime" failed/,
'female customer requiredTime value out of limits';
}
{ # male customer, tolerance not a number:
throws_ok { MaleCustomer->new( tolerance => 'potato' ) }
qr/potato is not a number/,
'male customer tolerance value failed isa check';
}
{ # female customer, requiredTime out of range:
throws_ok { FemaleCustomer->new( requiredTime => 'tomato' ) }
qr/isa check for "requiredTime" failed/,
'female customer requiredTime value failed isa check';
}
{ # test inheritance - no method parentMethodOnly() in child class:
my $male = MaleCustomer->new( tolerance => 45 );
is ( $male->parentMethodOnly, 'inheritance check OK', 'inheritance test passed' );
}
{ # AdvancedShop constructor, no seats param:
throws_ok { AdvancedShop->new() }
qr/Missing required arguments\: seats/,
'AdvancedShop constructor missing required arguments';
}
{ # AdvancedShop constructor, 4 seats:
my $o = AdvancedShop->new( seats => 4 );
my $que = $o->getQueue; # p $que;
is ( ref $que, 'ARRAY', 'got expected data structure for getQueue' );
is ( @$que, 4, 'got expected queue size' );
}
{ # test AdvancedShop->arrivingCustomer
my $o = AdvancedShop->new( seats => 4 );
my $new_customer = $o->arrivingCustomer(); # p $new_customer;
like ( ref $new_customer, qr/(fe)?malecustomer/i,
'have new customer object');
}
{ # test AdvancedShop->addToQueue
my $o = AdvancedShop->new( seats => 4 ); # p $o->getQueue;
is ( ref $o->getQueue->[0], '', '1st element of queue is empty' );
my $new_customer = $o->arrivingCustomer(); # p $new_customer;
my $success = $o->addToQueue($new_customer); # p $o->getQueue;
is ( $success, 1, 'successfully added new customer to queue');
like ( ref $o->getQueue->[0], qr/(fe)?malecustomer/i,
'1st element of queue is now a customer object' );
}
{ # test AdvancedShop->removeFromQueue
my $o = AdvancedShop->new( seats => 4 ); # p $o->getQueue;
my $new_customer = $o->arrivingCustomer(); # p $new_customer;
$o->addToQueue($new_customer); # p $o->getQueue;
my $success = $o->removeFromQueue(); # p $o->getQueue;
like ( $success, qr/(fe)?malecustomer/i, # returns Customer object
'successfully removed new customer from queue');
is ( ref $o->getQueue->[0], '', '1st element of queue is empty' );
}
{ # test AdvancedShop->expire
# expire() will remove 1st element if it's an object and its wait() value is <= 0
# after subtraction of shifted customers' $duration, or if it's a MaleCustomer
# & $duration > 35
my $o = AdvancedShop->new( seats => 4 ); # p $o->getQueue;
my $new_customer = $o->arrivingCustomer(); # say 'new customer:'.ref $new_customer;
# need at least 1 customer object in queue:
$o->addToQueue($new_customer); # p $o->getQueue;
# expire function accepts shifted 1st element so bypass shift stage:
my $simulated_removed_customer = $o->arrivingCustomer(); # say 'served customer:'.ref $simulated_removed_customer;
my $duration = $simulated_removed_customer->getRequiredTime;
my $wait = $new_customer->wait;
# say 'wait:'. $wait; say 'duration:'.$duration; say 'calc:'. ($wait - $duration);
$o->expire($simulated_removed_customer);
my $queue = $o->getQueue; # p $queue;
if ( ref $new_customer eq 'MaleCustomer' && $duration > 35 ) {
is ( $queue->[0], 0, 'male customer gone away due to excess wait' );
}
elsif ( $wait - $duration <= 0 ) {
is ( $queue->[0], 0, 'customer removed from queue' );
}
else { # $wait - $duration greater than zero, custumer still in queue:
like ( ref $o->getQueue->[0], qr/(fe)?malecustomer/i,
'customer still in queue');
}
# unlikely for new customer to expire on 1st cycle other than male & excess
# wait, due to duration value either 15 mins (male) or 20 - 50 mins (Female)
# need new customer to be male with low wait, and served (shifted) customer
# to be Female with duration > new customer wait, but < 35:
{
my $o = AdvancedShop->new( seats => 4 ); # p $o->getQueue;
my $new_customer = MaleCustomer->new(tolerance => 30); # lowest permitted
$o->addToQueue($new_customer); # p $o->getQueue;
# simulate shifted (served) customer to be female with time for haircut between 31 & 34:
my $simulated_removed_customer = FemaleCustomer->new(requiredTime => 31);
# get shifted (served) customers duration (time for hair cut) & remove from
my $duration = $simulated_removed_customer->getRequiredTime; # 31
# get waiting tolerance for next customer in line - is LESS than time
# for customer being served, so will expire from queue:
my $wait = $new_customer->wait; # 30
# say 'wait:'. $wait; say 'duration:'.$duration; say 'calc:'. ($wait - $duration);
is ( $wait - $duration, -1, 'duration exceeds wait for expire' );
$o->expire($simulated_removed_customer); # p $o->getQueue;
# expect this customer to have expired:
is ( $o->getQueue->[0], 0, 'customer removed from queue' );
}
}
{ # run AdvancedShop->serveOneCustomer with probablility 0.03:
my $o = AdvancedShop->new( seats => 4 );
my $revenue = $o->serveOneCustomer($p); # p $revenue;
# 1st return always zero (as no customer in queue:
is ( $revenue, 0, 'got expected revenue for 1st call to serveOneCustomer');
for ( 1 .. 10 ) {
my $revenue = $o->serveOneCustomer($p); # p $revenue;
like ( $revenue, qr/0|12|25/,
sprintf 'receieved �%s for customer %s', $revenue, $_);
}
}
{ # run 1 day (480 minutes, p = 0.03):
my $o = AdvancedShop->new( seats => 4 );
$o->runDay(480, $p);
my $revenue = $o->getTotalRevenue; # p $revenue;
like ( $revenue, qr/\d+/, sprintf 'revenue for 1 day = �%s', $revenue );
# p $o->customers;
}
{ # run for several days:
my $days = 365;
my $o = AdvancedShop->new( seats => 4 );
my $revenue = $o->averageRevenue(480, $days, $p); # p $revenue;
like ( $revenue, qr/\d+/,
sprintf 'average revenue for %s days = �%s', $days, $revenue );
my $total_customers = $o->customers;
my $female = $total_customers->{FemaleCustomer};
my $male = $total_customers->{MaleCustomer};
# caclculate customer frequency (just tests value begins with number; for info purposes):
like ( $female->{joined_queue}, qr{\d+},
'total female customers joined queue: ' . $female->{joined_queue} );
like ( $male->{joined_queue}, qr{\d+},
'total male customers joined queue: ' . $male->{joined_queue} );
like ( $female->{joined_queue} / $male->{joined_queue}, qr{\d+},
sprintf 'ratio female : male = %0.2f',
$female->{joined_queue} /
( $male->{joined_queue} + $female->{joined_queue} ) );
like ( $female->{served}, qr{\d+},
'total female customers served: ' . $female->{served} );
like ( $female->{served} / $male->{joined_queue}, qr{\d+},
sprintf 'ratio female customers served = %0.2f',
$female->{served} / $female->{joined_queue} );
like ( $male->{served}, qr{\d+},
'total male customers served: ' . $female->{served} );
like ( $female->{served} / $male->{joined_queue}, qr{\d+},
sprintf 'ratio of male customers served = %0.2f',
$male->{served} / $male->{joined_queue} );
}
done_testing();
