File Coverage

blib/lib/Finance/FITF/Writer.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch	1	2	50.0
condition	1	3	33.3
subroutine	5	5	100.0
pod			n/a
total	18	23	78.2

package Finance::FITF::Writer;
use strict;
use warnings;
BEGIN {
    eval "use Class::XSAccessor::Compat 'antlers'; 1" or
    eval "use Class::Accessor::Fast 'antlers'; 1" or die $@;
}
use DateTime;
use Carp qw(croak);

extends 'Finance::FITF';

has current_prices => ( is => 'rw' );

has bars_written => (is => "rw", isa => "Int");

has ticks_written => (is => "rw", isa => "Int");
has last_index => (is => "rw", isa => "Int");

has bar_index => (is => "rw", isa => "Int");

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    $self->ticks_written(0);
    $self->bars_written(0);
    $self->last_index(0);

    $self->bar_index(0);

    return $self;
}

sub add_session {
    my ($self, $start_offset, $end_offset) = @_;
    my $date_start = $self->{date_start};

    $self->{bar_ts} ||= [];
    if (scalar @{$self->header->{start}} >= 3) {
        croak "FITF supports up to 3 sessions only.";
    }
    push @{$self->header->{start}}, $date_start + $start_offset;
    push @{$self->header->{end}}, $date_start + $end_offset;
    push @{$self->{bar_ts}},
        map { $date_start + $start_offset + $_ * $self->{header}{bar_seconds} }
            (1..($end_offset - $start_offset) / $self->{header}{bar_seconds});
    $self->nbars( scalar @{$self->{bar_ts}} );
}

sub push_bar {
    my $self = shift;
    my $ts   = shift;
    my $frame = shift;
    my $pos = sysseek($self->{fh}, 0, 1);
    seek $self->{fh}, $self->header_sz + ($self->{bars_written}++) * $self->bar_sz, 0;
    syswrite $self->{fh}, $self->bar_fmt->format({ %$frame, index => $self->{last_index}});

    seek $self->{fh}, $pos, 0;
    $self->last_index( $self->ticks_written );
}

sub push_price {
    my ($self, $ts, $price, $volume) = @_;
    $price *= $self->{header}{divisor};
    unless ($self->ticks_written) {
        seek $self->{fh}, $self->header_sz + $self->nbars * $self->bar_sz, 0;
    }

    die unless @{$self->{bar_ts}};
    my $cp = $self->current_prices;
    my $last = $cp && $cp->{close} || 0;
    while ($ts >= $self->{bar_ts}[$self->{bar_index}]) {
        $self->push_bar($self->{bar_ts}[$self->{bar_index}++],
                      $cp || { open => $last, high => $last, low => $last, close => $last });
        $cp = undef;
    }

    if ($cp) {
        ++$cp->{ticks}; $cp->{volume} += $volume;
        $cp->{close} = $price;
        $cp->{high}  = $price if $price > $cp->{high};
        $cp->{low}   = $price if $price < $cp->{low};
    }
    else {
        $self->current_prices({ open => $price, close => $price,
                                volume => $volume, ticks => 1,
                                high => $price, low => $price });
    }
    my $offset = $ts - $self->{date_start};
    my $offset_min = int($offset/60);
    my $offset_msec = int(($offset - $offset_min*60 ) * 1000);
    syswrite $self->{fh}, $self->tick_fmt->format({ offset_min => $offset_min,
                                                    offset_msec => $offset_msec,
                                                    price => $price,
                                                    volume => $volume,
                                                });
    ++$self->{ticks_written};

}

sub end {
    my $self = shift;

    my $cp = $self->current_prices;
    my $last = $cp && $cp->{close} || 0;
    while ($self->{bar_index} < $self->{nbars}) {
        $self->push_bar($self->{bar_ts}[$self->{bar_index}++],
                      $cp || { open => $last, high => $last, low => $last, close => $last });
        $cp = undef;
    }

    $self->header->{start}[1] ||= 0;
    $self->header->{start}[2] ||= 0;
    $self->header->{end}[1] ||= 0;
    $self->header->{end}[2] ||= 0;

    $self->header->{records} = $self->{ticks_written};
    seek $self->{fh}, 0 ,0;
    syswrite $self->{fh}, $self->header_fmt->format($self->header);
}

1;

__END__