File Coverage

blib/lib/Finance/Contract.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Finance::Contract;
2              
3 1     1   49959 use strict;
  1         3  
  1         25  
4 1     1   5 use warnings;
  1         1  
  1         40  
5              
6             our $VERSION = '0.008';
7              
8             =head1 NAME
9              
10             Finance::Contract - represents a contract object for a single bet
11              
12             =head1 VERSION
13              
14             version 0.001
15              
16             =head1 SYNOPSIS
17              
18             use feature qw(say);
19             use Finance::Contract;
20             # Create a simple contract
21             my $contract = Finance::Contract->new(
22             contract_type => 'CALLE',
23             duration => '5t',
24             );
25              
26             =head1 DESCRIPTION
27              
28             This is a generic abstraction for financial stock market contracts.
29              
30             =head2 Construction
31              
32             Finance::Contract->new({
33             underlying => 'frxUSDJPY',
34             contract_type => 'CALL',
35             date_start => $now,
36             duration => '5t',
37             currency => 'USD',
38             payout => 100,
39             barrier => 100,
40             });
41              
42             =head2 Dates
43              
44             All date-related parameters:
45              
46             =over 4
47              
48             =item * L</date_pricing>
49              
50             =item * L</date_expiry>
51              
52             =item * L</date_start>
53              
54             =back
55              
56             are L<Date::Utility> instances. You can provide them as epoch values
57             or L<Date::Utility> objects.
58              
59             =cut
60              
61 1     1   455 use Moose;
  1         388808  
  1         8  
62 1     1   7945 use MooseX::Types::Moose qw(Int Num Str);
  0            
  0            
63             use MooseX::Types -declare => ['contract_category'];
64             use Moose::Util::TypeConstraints;
65              
66             use Time::HiRes qw(time);
67             use List::Util qw(min max first);
68             use Scalar::Util qw(looks_like_number);
69             use Math::Util::CalculatedValue::Validatable;
70             use Date::Utility;
71             use Format::Util::Numbers qw(roundnear);
72             use POSIX qw( floor );
73             use Time::Duration::Concise;
74              
75             # Types used for date+time-related handling
76              
77             use Finance::Contract::Category;
78              
79             use constant _FOREX_BARRIER_MULTIPLIER => 1e6;
80              
81             unless(find_type_constraint('time_interval')) {
82             subtype 'time_interval', as 'Time::Duration::Concise';
83             coerce 'time_interval', from 'Str', via { Time::Duration::Concise->new(interval => $_) };
84             }
85              
86             unless(find_type_constraint('date_object')) {
87             subtype 'date_object', as 'Date::Utility';
88             coerce 'date_object', from 'Str', via { Date::Utility->new($_) };
89             }
90              
91             my @date_attribute = (
92             isa => 'date_object',
93             lazy_build => 1,
94             coerce => 1,
95             );
96              
97             =head1 ATTRIBUTES
98              
99             These are the parameters we expect to be passed when constructing a new contract.
100              
101             =cut
102              
103             =head2 bet_type
104              
105             (required) The type of this contract as an upper-case string.
106              
107             Current types include:
108              
109             =over 4
110              
111             =item * ASIAND
112              
113             =item * ASIANU
114              
115             =item * CALL
116              
117             =item * CALLE
118              
119             =item * DIGITDIFF
120              
121             =item * DIGITEVEN
122              
123             =item * DIGITMATCH
124              
125             =item * DIGITODD
126              
127             =item * DIGITOVER
128              
129             =item * DIGITUNDER
130              
131             =item * EXPIRYMISS
132              
133             =item * EXPIRYMISSE
134              
135             =item * EXPIRYRANGE
136              
137             =item * EXPIRYRANGEE
138              
139             =item * NOTOUCH
140              
141             =item * ONETOUCH
142              
143             =item * PUT
144              
145             =item * PUTE
146              
147             =item * RANGE
148              
149             =item * UPORDOWN
150              
151             =back
152              
153             =cut
154              
155             has bet_type => (
156             is => 'ro',
157             isa => 'Str',
158             required => 1,
159             );
160              
161             =head2 currency
162              
163             (required) The currency of the payout for this contract, e.g. C<USD>.
164              
165             =cut
166              
167             has currency => (
168             is => 'ro',
169             isa => 'Str',
170             required => 1,
171             );
172              
173             =head2 date_expiry
174              
175             (optional) When the contract expires.
176              
177             One of C<date_expiry> or L</duration> must be provided.
178              
179             =cut
180              
181             has date_expiry => (
182             is => 'rw',
183             @date_attribute,
184             );
185              
186             =head2 date_pricing
187              
188             (optional) The date at which we're pricing the contract. Provide C< undef > to indicate "now".
189              
190             =cut
191              
192             has date_pricing => (
193             is => 'ro',
194             @date_attribute,
195             );
196              
197             =head2 date_start
198              
199             For American contracts, defines when the contract starts.
200              
201             For Europeans, this is used to determine the barrier when the requested barrier is relative.
202              
203             =cut
204              
205             has date_start => (
206             is => 'ro',
207             @date_attribute,
208             );
209              
210             =head2 duration
211              
212             (optional) The requested contract duration, specified as a string indicating value with units.
213             The unit is provided as a single character suffix:
214              
215             =over 4
216              
217             =item * t - ticks
218              
219             =item * s - seconds
220              
221             =item * m - minutes
222              
223             =item * h - hours
224              
225             =item * d - days
226              
227             =back
228              
229             Examples would be C< 5t > for 5 ticks, C< 3h > for 3 hours.
230              
231             One of L</date_expiry> or C<duration> must be provided.
232              
233             =cut
234              
235             has duration => (is => 'ro');
236              
237             =head2 is_forward_starting
238              
239             True if this contract is considered as forward-starting at L</date_pricing>.
240              
241             =cut
242              
243             # TODO This should be a method, but will cause test failures since there are
244             # places where we set this explicitly.
245             has is_forward_starting => (
246             is => 'ro',
247             lazy_build => 1,
248             );
249              
250             =head2 payout
251              
252             Payout amount value, see L</currency>. Optional - only applies to binaries.
253              
254             =cut
255              
256             has payout => (
257             is => 'ro',
258             isa => 'Num',
259             lazy_build => 1,
260             );
261              
262             =head2 prediction
263              
264             Prediction (for tick trades) is what client predicted would happen.
265              
266             =cut
267              
268             has prediction => (
269             is => 'ro',
270             isa => 'Maybe[Num]',
271             );
272              
273             =head2 starts_as_forward_starting
274              
275             This attribute tells us if this contract was initially bought as a forward starting contract.
276             This should not be mistaken for L</is_forward_starting> attribute as that could change over time.
277              
278             =cut
279              
280             has starts_as_forward_starting => (
281             is => 'ro',
282             default => 0,
283             );
284              
285             =head2 pip_size
286              
287             Barrier pip size the minimum fluctuation amount for type of market. It is normally fraction.
288              
289             =cut
290              
291             has pip_size => (
292             is => 'ro',
293             isa => 'Num',
294             lazy_build => 1
295             );
296              
297             =head2 absolute_barrier_multiplier
298              
299             Should barrier multiplier be applied for absolute barried on this market
300              
301             =cut
302              
303             has 'absolute_barrier_multiplier' => (
304             is => 'ro',
305             isa => 'Bool',
306             );
307              
308             =head2 supplied_barrier_type
309              
310             One of:
311              
312             =over 4
313              
314             =item * C<relative> - this is of the form C<< S10P >> or C<< S-4P >>, which would be 10 pips above the spot
315             or 4 pips below the spot.
316              
317             =item * C<absolute> - this is a number that can be compared directly with the spot, e.g. C<< 103.45 >>.
318              
319             =item * C<difference> - a numerical difference from the spot, can be negative, e.g. C<< -0.035 >>.
320              
321             =back
322              
323             =cut
324              
325             has supplied_barrier_type => (
326             is => 'ro',
327             );
328              
329             =head2 supplied_high_barrier
330              
331             For a 2-barrier contract, this is the high barrier string. The meaning of these barrier values is controlled by L</supplied_barrier_type>.
332              
333             =head2 supplied_low_barrier
334              
335             For a 2-barrier contract, this is the low barrier string.
336              
337             =head2 supplied_barrier
338              
339             For a single-barrier contract, this is the barrier string.
340              
341             =cut
342              
343             has [qw(supplied_barrier supplied_high_barrier supplied_low_barrier)] => (is => 'ro');
344              
345             =head2 tick_count
346              
347             Number of ticks in this trade.
348              
349             =cut
350              
351             has tick_count => (
352             is => 'ro',
353             isa => 'Maybe[Num]',
354             );
355              
356             has remaining_time => (
357             is => 'ro',
358             isa => 'Time::Duration::Concise',
359             lazy_build => 1,
360             );
361              
362             =head2 underlying_symbol
363              
364             The underlying asset, as a string (for example, C< frxUSDJPY >).
365              
366             =cut
367              
368             has xxx_underlying_symbol => (
369             is => 'ro',
370             isa => 'Str',
371             );
372              
373             # This is needed to determine if a contract is newly priced
374             # or it is repriced from an existing contract.
375             # Milliseconds matters since UI is reacting much faster now.
376             has _date_pricing_milliseconds => (
377             is => 'rw',
378             );
379              
380             =head1 ATTRIBUTES - From contract_types.yml
381              
382             =head2 id
383              
384             A unique numeric ID.
385              
386             =head2 pricing_code
387              
388             Used to determine the pricing engine that should be used for this contract. Examples
389             include 'PUT' or 'CALL'.
390              
391             =head2 display_name
392              
393             This is a human-readable name for the contract type, brief description of what it does.
394              
395             =head2 sentiment
396              
397             Indicates whether we are speculating on market rise or fall.
398              
399             =head2 other_side_code
400              
401             Opposite type for this contract - PUT for CALL, etc.
402              
403             =head2 payout_type
404              
405             Either C< binary > or C< non-binary >.
406              
407             =head2 payouttime
408              
409             Indicates when the contract pays out. Can be C< end > or C< hit >.
410              
411             =cut
412              
413             has [qw(id pricing_code display_name sentiment other_side_code payout_type payouttime)] => (
414             is => 'ro',
415             default => undef,
416             );
417              
418             =head1 ATTRIBUTES - From contract_categories.yml
419              
420             =cut
421              
422             subtype 'contract_category', as 'Finance::Contract::Category';
423             coerce 'contract_category', from 'Str', via { Finance::Contract::Category->new($_) };
424              
425             has category => (
426             is => 'ro',
427             isa => 'contract_category',
428             coerce => 1,
429             handles => [qw(
430             allow_forward_starting
431             barrier_at_start
432             is_path_dependent
433             supported_expiries
434             two_barriers
435             )],
436             );
437              
438             =head2 allow_forward_starting
439              
440             True if we allow forward starting for this contract type.
441              
442             =cut
443              
444             =head2 barrier_at_start
445              
446             Boolean which will false if we don't know what the barrier is at the start of the contract (Asian contracts).
447              
448             =cut
449              
450             =head2 category_code
451              
452             The code for this category.
453              
454             =cut
455              
456             sub category_code {
457             my $self = shift;
458             return $self->category->code;
459             }
460              
461             =head2 is_path_dependent
462              
463             True if this is a path-dependent contract.
464              
465             =cut
466              
467             =head2 supported_expiries
468              
469             Which expiry durations we allow for this category. Values can be:
470              
471             =over 4
472              
473             =item * intraday
474              
475             =item * daily
476              
477             =item * tick
478              
479             =back
480              
481             =cut
482              
483             =head2 two_barriers
484              
485             True if the contract has two barriers.
486              
487             =cut
488              
489             =head1 METHODS
490              
491             =cut
492              
493             our $BARRIER_CATEGORIES = {
494             callput => ['euro_atm', 'euro_non_atm'],
495             endsinout => ['euro_non_atm'],
496             touchnotouch => ['american'],
497             staysinout => ['american'],
498             digits => ['non_financial'],
499             asian => ['asian'],
500             };
501              
502             =head2 barrier_category
503              
504             Type of barriers we have for this contract, depends on the contract type.
505              
506             Possible values are:
507              
508             =over 4
509              
510             =item * C<american> - barrier for American-style contract
511              
512             =item * C<asian> - Asian-style contract
513              
514             =item * C<euro_atm> - at-the-money European contract
515              
516             =item * C<euro_non_atm> - non-at-the-money European contract
517              
518             =item * C<non_financial> - digits
519              
520             =back
521              
522             =cut
523              
524             sub barrier_category {
525             my $self = shift;
526              
527             my $barrier_category;
528             if ($self->category->code eq 'callput') {
529             $barrier_category = ($self->is_atm_bet) ? 'euro_atm' : 'euro_non_atm';
530             } else {
531             $barrier_category = $BARRIER_CATEGORIES->{$self->category->code}->[0];
532             }
533              
534             return $barrier_category;
535             }
536              
537             =head2 effective_start
538              
539             =over 4
540              
541             =item * For backpricing, this is L</date_start>.
542              
543             =item * For a forward-starting contract, this is L</date_start>.
544              
545             =item * For all other states - i.e. active, non-expired contracts - this is L</date_pricing>.
546              
547             =back
548              
549             =cut
550              
551             sub effective_start {
552             my $self = shift;
553              
554             return
555             ($self->date_pricing->is_after($self->date_expiry)) ? $self->date_start
556             : ($self->date_pricing->is_after($self->date_start)) ? $self->date_pricing
557             : $self->date_start;
558             }
559              
560             =head2 fixed_expiry
561              
562             A Boolean to determine if this bet has fixed or flexible expiries.
563              
564             =cut
565              
566             has fixed_expiry => (
567             is => 'ro',
568             default => 0,
569             );
570              
571             =head2 get_time_to_expiry
572              
573             Returns a TimeInterval to expiry of the bet. For a forward start bet, it will NOT return the bet lifetime, but the time till the bet expires.
574              
575             If you want to get the contract life time, use:
576              
577             $contract->get_time_to_expiry({from => $contract->date_start})
578              
579             =cut
580              
581             sub get_time_to_expiry {
582             my ($self, $attributes) = @_;
583              
584             $attributes->{'to'} = $self->date_expiry;
585              
586             return $self->_get_time_to_end($attributes);
587             }
588              
589             =head2 is_after_expiry
590              
591             Returns true if the contract is already past the expiry time.
592              
593             =cut
594              
595             sub is_after_expiry {
596             my $self = shift;
597              
598             die "Not supported for tick expiry contracts" if $self->tick_expiry;
599              
600             return ($self->get_time_to_expiry->seconds == 0) ? 1 : 0;
601             }
602              
603             =head2 is_atm_bet
604              
605             Is this contract meant to be ATM or non ATM at start?
606             The status will not change throughout the lifetime of the contract due to differences in offerings for ATM and non ATM contracts.
607              
608             =cut
609              
610             sub is_atm_bet {
611             my $self = shift;
612              
613             return 0 if $self->two_barriers;
614             # if not defined, it is non ATM
615             return 0 if not defined $self->supplied_barrier;
616             return 0 if $self->supplied_barrier ne 'S0P';
617             return 1;
618             }
619              
620             =head2 shortcode
621              
622             This is a compact string representation of a L<Finance::Contract> object. It includes all data needed to
623             reconstruct a contract, with the exception of L</currency>.
624              
625             =cut
626              
627             sub shortcode {
628             my $self = shift;
629              
630             my $shortcode_date_start = (
631             $self->is_forward_starting
632             or $self->starts_as_forward_starting
633             ) ? $self->date_start->epoch . 'F' : $self->date_start->epoch;
634             my $shortcode_date_expiry =
635             ($self->tick_expiry) ? $self->tick_count . 'T'
636             : ($self->fixed_expiry) ? $self->date_expiry->epoch . 'F'
637             : $self->date_expiry->epoch;
638              
639             # TODO We expect to have a valid bet_type, but there may be codepaths which don't set this correctly yet.
640             my $contract_type = $self->bet_type // $self->code;
641             my @shortcode_elements = ($contract_type, $self->underlying->symbol, $self->payout, $shortcode_date_start, $shortcode_date_expiry);
642              
643             if ($self->two_barriers) {
644             push @shortcode_elements, map { $self->_barrier_for_shortcode_string($_) } ($self->supplied_high_barrier, $self->supplied_low_barrier);
645             } elsif (defined $self->supplied_barrier and $self->barrier_at_start) {
646             push @shortcode_elements, ($self->_barrier_for_shortcode_string($self->supplied_barrier), 0);
647             }
648              
649             return uc join '_', @shortcode_elements;
650             }
651              
652             =head2 tick_expiry
653              
654             A boolean that indicates if a contract expires after a pre-specified number of ticks.
655              
656             =cut
657              
658             sub tick_expiry {
659             my ($self) = @_;
660             return $self->tick_count ? 1 : 0;
661             }
662              
663             =head2 timeinyears
664              
665             Contract duration in years.
666              
667             =head2 timeindays
668              
669             Contract duration in days.
670              
671             =cut
672              
673             has [qw(
674             timeinyears
675             timeindays
676             )
677             ] => (
678             is => 'ro',
679             init_arg => undef,
680             isa => 'Math::Util::CalculatedValue::Validatable',
681             lazy_build => 1,
682             );
683              
684             sub _build_timeinyears {
685             my $self = shift;
686              
687             my $tiy = Math::Util::CalculatedValue::Validatable->new({
688             name => 'time_in_years',
689             description => 'Bet duration in years',
690             set_by => 'Finance::Contract',
691             base_amount => 0,
692             minimum => 0.000000001,
693             });
694              
695             my $days_per_year = Math::Util::CalculatedValue::Validatable->new({
696             name => 'days_per_year',
697             description => 'We use a 365 day year.',
698             set_by => 'Finance::Contract',
699             base_amount => 365,
700             });
701              
702             $tiy->include_adjustment('add', $self->timeindays);
703             $tiy->include_adjustment('divide', $days_per_year);
704              
705             return $tiy;
706             }
707              
708             sub _build_timeindays {
709             my $self = shift;
710              
711             my $atid = $self->get_time_to_expiry({
712             from => $self->effective_start,
713             })->days;
714              
715             my $tid = Math::Util::CalculatedValue::Validatable->new({
716             name => 'time_in_days',
717             description => 'Duration of this bet in days',
718             set_by => 'Finance::Contract',
719             minimum => 0.000001,
720             maximum => 730,
721             base_amount => $atid,
722             });
723              
724             return $tid;
725             }
726              
727             # INTERNAL METHODS
728              
729             # Send in the correct 'to'
730             sub _get_time_to_end {
731             my ($self, $attributes) = @_;
732              
733             my $end_point = $attributes->{to};
734             my $from = ($attributes and $attributes->{from}) ? $attributes->{from} : $self->date_pricing;
735              
736             # Don't worry about how long past expiry
737             # Let it die if they gave us nonsense.
738              
739             return Time::Duration::Concise->new(
740             interval => max(0, $end_point->epoch - $from->epoch),
741             );
742             }
743              
744             #== BUILDERS =====================
745              
746             sub _build_date_pricing {
747             return Date::Utility->new;
748             }
749              
750             sub _build_is_forward_starting {
751             my $self = shift;
752              
753             return ($self->allow_forward_starting and $self->date_pricing->is_before($self->date_start)) ? 1 : 0;
754             }
755              
756             sub _build_remaining_time {
757             my $self = shift;
758              
759             my $when = ($self->date_pricing->is_after($self->date_start)) ? $self->date_pricing : $self->date_start;
760              
761             return $self->get_time_to_expiry({
762             from => $when,
763             });
764             }
765              
766             sub _build_date_start {
767             return Date::Utility->new;
768             }
769              
770             # Generates a string version of a barrier by multiplying the actual barrier to remove the decimal point
771             sub _barrier_for_shortcode_string {
772             my ($self, $string) = @_;
773              
774             return $string if $self->supplied_barrier_type eq 'relative';
775             return 'S' . roundnear(1, $string / $self->pip_size) . 'P' if $self->supplied_barrier_type eq 'difference';
776              
777             $string = $self->_pipsized_value($string);
778             if ($self->absolute_barrier_multiplier) {
779             $string *= _FOREX_BARRIER_MULTIPLIER;
780             } else {
781             $string = floor($string);
782             }
783              
784             # Make sure it's an integer
785             $string = roundnear(1, $string);
786              
787             return $string;
788             }
789              
790             sub _pipsized_value {
791             my ($self, $value) = @_;
792              
793             my $display_decimals = log(1 / $self->pip_size) / log(10);
794             $value = sprintf '%.' . $display_decimals . 'f', $value;
795             return $value;
796             }
797              
798             no Moose;
799             __PACKAGE__->meta->make_immutable;
800              
801             1;