package Finance::IG;

use 5.006;
use strict;
no strict 'refs'; 
use warnings;

=encoding utf8

=head1 NAME

Finance::IG - - Module for doing useful stuff with IG Markets REST API.

=head1 DESCRIPTION

This is very much a first draft, but will enable you to get simple arrays of positions, print them out possily some simple trading.

Its proof of concept in perl beyond anything else, extend it as you need to.

I have only used it for spreadbet accounts, it would be simple to extend to CFD's but I dont have CFD data or an interest in CFD's so have not done this. 

You will need an API key to use this module, available free from IG Markets. 

=head1 VERSION

Version 0.08

=cut

our $VERSION = '0.08';


=head1 SYNOPSIS

   use Finance::IG;
   use strict;
   no strict 'refs';
   use warnings;

   my $ig=iFinance::IG->new(
                username=> "demome",
                password=> "mypassword",
                apikey=>   "4398232394029341776153276512736icab",
                isdemo=>0,
   );
   $ig->login;
 
   my $p=$ig->positions();    #  Get a list of positions
   $p=$ig->agg($p,$sortlist); #  Aggregate them, so one item per instrument. 

   my $format="%-41sinstrumentName %+6.2fsize %-9.2flevel ".
           "%-9.2fbid £%-8.2fprofit %5.1fprofitpc%% £%10.2fatrisk\n",

   $ig->printpos("stdout" , [], $format); 

   for my $position (@$p)
   { 
       $ig-> printpos("stdout" ,$position,$format); 
   } 

=head1 UTILITIES

The utility igdisp.pl is installed with this module and may be used to list your positions on IG.  A help message can be obtained with igdisp.pl -h 

=head1 SUBROUTINES/METHODS

This is a list of currently implemented methods

=head2 new
  
Normal parameters, as above.

col=>1

Causes Finance::IG to try to use Term::Chrome to do some simple coloration of output.
If Term::Chrome is not installed, it will be silently ignored. See printpos.

=head2 login, needs to be called once after new and before other calls.

No Parameters.

=head2 printpos print out a formatted hash as one line

Parameters
 
 file - can be a file handle or the string stdout or the glob *STDOUT 
 A position of other shallow hash, 
 A format string. The format string is similar to a printf format string, for example %s says print out a string
     however, the name of the item to be printed follows the letter, eg %sinstrumentName print the string instrument name. 
 optional up
 optional down 

A title line can be printed by either passing an array ref instead of a position, in which case the array ref can contain
the titles to print. If the array is empty then the titles will be generated from the format string.

up and down can be provided and represent negative and posite limits on dbid element by default. 
Alternatively, provide up only and make it a subroutine ref. 

The subroutime takes parameter a position, and should return escape characters (from Term::Chrome to colorise the line. 

=head2 transactions - retrieve transactions history 

transactions(++$page,Time::Piece->strptime("2020-01-01","%Y-%m-%d-%H.%M"),scalar localtime)

Parameters

Paging number, start at 1
Start time, can be a string or a Time::Piece
Endtime

return a reference to an array of transactions for that time span. Each transaction is a hash of data.

=cut 

use Moose;
use JSON;
use REST::Client;
#use Data::Dump qw(dump); # used in some commented out debug statements
#use Scalar::Util;
use Time::Piece;

BEGIN {
        if (eval("require Term::Chrome"))
        {
           Term::Chrome->import();
        }
        else
        {
           map { eval ("sub $_ {}") } qw(Red Blue Bold Reset Underline Green color); # need these to avoid compile time errors. 
        }
      }
has 'apikey' => (
                   is=>'ro',
                   isa=>'Str',
                   required=>1,
                );
has 'username' => (
                   is=>'ro',
                   isa=>'Str',
                   required=>1,
                );
has 'password' => (
                   is=>'ro',
                   isa=>'Str',
                   required=>1,
                );
has 'isdemo' => (
                   is=>'ro',
                   isa=>'Bool',
                   required=>1,
                );
has 'CST' => (
                   is=>'rw',
                   isa=>'Str',
                );
has 'XSECURITYTOKEN' => (
                   is=>'rw',
                   isa=>'Str',
                );

has 'XSTTIME' => (
                   is=>'rw',
                   isa=>'Int',
                );
has 'col' => (  # set to 1 to use Term::Chrome for coloration. 
                        is=>'rw',
                        isa=>'Bool',
                        default=>0,
                      );
has 'uds' => (
                        is=>'rw',
                        isa=>'Str',
                        default=>'',
                     );

sub _url
{
               my ($self) = @_;
               return 'https://demo-api.ig.com/gateway/deal' if ( $self->isdemo);
               return 'https://api.ig.com/gateway/deal';
}


##########################################################################
=head2 login - loginto the account. 

 Parameters - none 

login to the object, using the parameters provided to new. 

You should call this just once per object after calling new.  

=cut 
##########################################################################
sub login {
               my ($self) = @_;
               my $headers =
                        {
                            'Content-Type' => 'application/json; charset=UTF-8',
                            'Accept' =>  'application/json; charset=UTF-8',
                            VERSION => 2,
                            'X-IG-API-KEY'=> $self->apikey
                        };
                my $data =  {
                             identifier  => $self->username,
                             password  => $self->password,
                            };
                # my $jdata = encode_json($data);
                my $jdata=JSON->new->canonical->encode($data);

                my $client = REST::Client->new();
                $client->setHost($self->_url);


                $client->POST (
                               '/session',
                               $jdata,
                               $headers
                              );
                my $code=$client->responseCode();
                die "response code from login $code" if ($code!=200);
                $self->CST($client->responseHeader('CST')   // die "No CST header in login response");
                $self->XSECURITYTOKEN($client->responseHeader('X-SECURITY-TOKEN') // die "No X-SECURITY-TOKEN in login response header");
                $self->XSTTIME(time());
                return;
   }
##########################################################################

=head2 flatten 

Parameters 
  1 Ref to array of hashes to flatten or a ref to a hash to flatten
  2 ref to an array of items to flatten, or just a single item name.  

Typical use of this is for a position that as it comes back from IG contains a market and a position
byut we would prefer all items at the top level. This would moves all the keys of position and market up one level and 
would remove the keys market and position. 

$self->flatten($hash, [qw(market position)]);   

=cut 
##########################################################################
sub flatten
{
   my ($self)=shift;
   my ($hash)=shift;
   my ($toflatten)=shift;

   $hash=[$hash] if (ref($hash) ne  'ARRAY');
   $toflatten=[$toflatten] if (ref($toflatten) ne 'ARRAY');

   for my $h (@$hash)
   {
    for my $key (@$toflatten)
    {
      if (exists($h->{$key}))
      {
         if (defined($h->{$key}))
         {
            die "key $key to flatten is not a hash" if (ref($h->{$key}) ne 'HASH');
            for my $subkey (keys %{$h->{$key}})
            {
              die "subkey exists $subkey" if (exists($h->{$subkey}));
              $h->{$subkey}=$h->{$key}->{$subkey};
            }
         }
         delete $h->{$key};
      }
    }
   }
}
sub transactions
{

   my ($self) = shift;
   my ($pageNumber)=shift;
   my ($from) =shift;
   my ($to)=shift;

   my $pageSize=50;

   $from//='';
   $to//='';

   if (ref($to) eq 'Time::Piece')
   {
      $to=$to->strftime("%Y-%m-%dT%H:%M:%S");
   }
   if (ref($from) eq 'Time::Piece')
   {
      $from=$from->strftime("%Y-%m-%dT%H:%M:%S");
   }
   $to=~m/^[-0-9T:]*$/ or die "Invalid date format for 'to' $to, is a ".ref(\$to);
   $from=~m/^[-0-9T:]*$/ or die "Invalid date format for 'from' $from";

   my $headers =    {
                       'Content-Type' => 'application/json; charset=UTF-8',
                       'Accept' =>  'application/json; charset=UTF-8',
                       VERSION => 2,
                       CST=>$self->CST,
                       'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
                       'X-IG-API-KEY'=> $self->apikey,
                    };
    #my $jheaders = encode_json($headers);
    my $jheaders=JSON->new->canonical->encode($headers);

    my $client = REST::Client->new();
    $client->setHost($self->_url);

    $from and $from="from=$from";
    $to and $to="to=$to";
    my $rpage=$pageNumber; # requested page number as integer, 1 is first 
    $pageNumber and $pageNumber="pageNumber=$pageNumber";
    $pageSize and $pageSize="pageSize=$pageSize";

     my $url=join '', map { $_?'&'.$_:'' } ($from,$to,$pageNumber,$pageSize);
     $url=~s/^&//;
     $url='?'.$url if ($url);

     $url='/history/transactions'.$url;
    $client->GET (
                      $url,
                      $headers
                    );

     my $code=$client->responseCode();
     if ($code==200)
     {
        my $resp=decode_json($client->responseContent());
#         $resp=$self->flatten($resp,[qw/transactions metadata/]); 
         #die encode_json($resp); 

        my @activities=@{$resp->{transactions}};
        # pncerint encode_json( $resp->{metadata} ); 
        # {"pageData":{"totalPages":11,"pageNumber":11,"pageSize":50},"size":534}***** 34
        return undef if ($rpage > $resp->{metadata}->{pageData}->{pageNumber});
        # return undef if (@activities==0); 
        return \@activities;
     }
     else
     {
       print "failed $code: ".$client->responseContent()."\n";
       return undef;
     }
}

#  example from/ to sting format: 
#  2020-10-28
#  2020-10-28T15:30

# keys in retirn, when called with detailed=1
# type, goodTillDate, actions(ARRAY) , epic, direction, level, channel, marketName, date, dealReference, guaranteedStop, stopLevel, size, currency, stopDistance, trailingStep, status, trailingStopDistance, limitLevel, description, dealId, period, limitDistance
# without: 
# period, details, date, dealId, epic, description, channel, status, type

sub history
{
   my ($self) = shift;
   my ($detailed)=shift; ## undef, not detailed, 1 for detailed. 
   my ($pageNumber)=shift;


   my ($from) = shift;
   my ($to) = shift;

   $pageNumber//='';
   my $pageSize=50;

   $from//='';
   $to//='';

   if (ref($to) eq 'Time::Piece')
   {
      $to=$to->strftime("%Y-%m-%dT%H:%M:%S");
   }
   if (ref($from) eq 'Time::Piece')
   {
      $from=$from->strftime("%Y-%m-%dT%H:%M:%S");
   }

   $to=~m/^[-0-9T:]*$/ or die "Invalid date format for 'to' $to";
   $from=~m/^[-0-9T:]*$/ or die "Invalid date format for 'from' $from";

   my $headers =    {
                       'Content-Type' => 'application/json; charset=UTF-8',
                       'Accept' =>  'application/json; charset=UTF-8',
                       VERSION => 2,
                       CST=>$self->CST,
                       'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
                       'X-IG-API-KEY'=> $self->apikey,
                    };
    #my $jheaders = encode_json($headers);
    my $jheaders=JSON->new->canonical->encode($headers);

    my $client = REST::Client->new();
    $client->setHost($self->_url);
    $from="from=$from" if ($from ne '');
    $to="to=$to" if ($to ne '');
    if ($detailed)
    {
       $detailed="detailed=true"
    }
    else
    {
       $detailed='';
    }

    $pageNumber="pageNumber=$pageNumber" if ($pageNumber);
    $pageSize//='';
    $pageSize="pageSize=$pageSize" if ($pageSize);

#    my $sep='?'; 
#    map { $_ eq '' or $_=$sep.$_ and $sep='&'} ($from,$to,$detailed,$pageNumber,$pageSize); 

     my $url=join '', map { $_?'&'.$_:'' } ($from,$to,$detailed,$pageNumber,$pageSize);
     $url=~s/^&//;
     $url='?'.$url if ($url);

     $url='/history/activity'.$url;

    # die $url; 

    $client->GET (
                      $url,
                      $headers
                    );

     my $code=$client->responseCode();

     if ($code==200)
     {
        my $resp=decode_json($client->responseContent());
        my @activities=@{$resp->{activities}};
        return undef if (@activities==0);
        $self->flatten(\@activities,'details');
        return \@activities;
     }
     else
     {
       print "failed $code: ".$client->responseContent()."\n";
       return undef;
     }
}
# example response: 
#{"metadata":{"paging":{"size":50,"next":"/history/activity?version=3&from=2020-10-28T00:00:00&to=2020-10-29T16:41:45&detailed=false&pageSize=50"}}
#  "activities": [.... ] 
# }
# each activity looks like: 
#{
# details=>null,
# dealId=>"DIAAAAFRS39HJAK",
# period=>"DFB",
# type=>"POSITION",
# epic=>"UA.D.ATVI.DAILY.IP",
# description=>"Position partially closed=> J6GK8WA9",
# date=>"2020-10-29T17:47:46",
# status=>"ACCEPTED",
# channel=>"SYSTEM"
#
# or with detail 
# {"activities":
#      [
#      [
#        {"date":"2020-11-19T18:41:04",
#         "epic":"UC.D.MU.DAILY.IP",
#         "period":"DFB",
#         "dealId":"DIAAAAFVXZV5LA5",
#         "channel":"WEB",
#         "type":"POSITION",
#         "status":"ACCEPTED",
#         "description":"Position opened: VXZV5LA5",
#         "details":
#                    {
#                      "dealReference":"6XQESB1EQGWY4FR2",
#                      "actions":
#                           [
#                             {"actionType":"POSITION_OPENED",
#                              "affectedDealId":"DIAAAAFVXZV5LA5"
#                             }
#                           ],
#                        "marketName":"Micron Technology Inc (All Sessions)",
#                        "goodTillDate":null,
#                        "currency":"GBP",
#                        "size":0.4,
#                        "direction":"BUY",
#                        "level":6123,
#                        "stopLevel":null,
#                        "stopDistance":null,
#                        "guaranteedStop":false,
#                        "trailingStopDistance":null,
#                        "trailingStep":null,
#                        "limitLevel":null,
#                        "limitDistance":null
#                      }
#       },
#       {"date":"2020-11-17T11:33:52",
#"epic":"KA.D.FSTA.DAILY.IP",
#"period":"DFB",
#"dealId":"DIAAAAFVEFD4GAG",
#"channel":"WEB",
#"type":"POSITION",
#"status":"ACCEPTED",
#"description":"Position/s closed: HH93GXAZ",
#"details":{"dealReference":"6XQESB1EQAZNR6V3",
#"actions":[{"actionType":"POSITION_CLOSED",
#"affectedDealId":"DIAAAAFHH93GXAZ"}],
#"marketName":"Fuller Smith & Turner",
#"goodTillDate":null,
#"currency":"GBP",
#"size":1,
#"direction":"SELL",
#"level":726.2,
#"stopLevel":null,
#"stopDistance":null,
#"guaranteedStop":false,
#"trailingStopDistance":null,
#"trailingStep":null,
#"limitLevel":null,
#"limitDistance":null}},
#}

# with detailed=1

#{
#  "activities": [
#    {
#      "date": "2020-11-19T18:41:04",
#      "epic": "UC.D.MU.DAILY.IP",
#      "period": "DFB",
#      "dealId": "DIAAAAFVXZV5LA5",
#      "channel": "WEB",
#      "type": "POSITION",
#      "status": "ACCEPTED",
#      "description": "Position opened: VXZV5LA5",
#      "details": {
#        "dealReference": "6XQESB1EQGWY4FR2",
#        "actions": [
#          {
#            "actionType": "POSITION_OPENED",
#            "affectedDealId": "DIAAAAFVXZV5LA5"
#          }
#        ],
#        "marketName": "Micron Technology Inc (All Sessions)",
#        "goodTillDate": null,
#        "currency": "GBP",
#        "size": 0.4,
#        "direction": "BUY",
#        "level": 6123,
#        "stopLevel": null,
#        "stopDistance": null,
#        "guaranteedStop": false,
#        "trailingStopDistance": null,
#        "trailingStep": null,
#        "limitLevel": null,
#        "limitDistance": null
#      }
#    },
#    {
#      "date": "2020-11-17T11:33:52",
#      "epic": "KA.D.FSTA.DAILY.IP",
#      "period": "DFB",
#      "dealId": "DIAAAAFVEFD4GAG",
#      "channel": "WEB",
#      "type": "POSITION",
#      "status": "ACCEPTED",
#      "description": "Position/s closed: HH93GXAZ",
#      "details": {
#        "dealReference": "6XQESB1EQAZNR6V3",
#        "actions": [
#          {
#            "actionType": "POSITION_CLOSED",
#            "affectedDealId": "DIAAAAFHH93GXAZ"
#          }
#        ],
#        "marketName": "Fuller Smith & Turner",
#        "goodTillDate": null,
#        "currency": "GBP",
#        "size": 1,
#        "direction": "SELL",
#        "level": 726.2,
#        "stopLevel": null,
#        "stopDistance": null,
#        "guaranteedStop": false,
#        "trailingStopDistance": null,
#        "trailingStep": null,
#        "limitLevel": null,
#        "limitDistance": null
#      }
#    },
#    {
#      "date": "2020-11-17T11:33:09",
#      "epic": "KA.D.FSTA.DAILY.IP",
#      "period": "DFB",
#      "dealId": "DIAAAAFVEFBBKA4",
#      "channel": "WEB",
#      "type": "POSITION",
#      "status": "ACCEPTED",
#      "description": "Position opened: VEFBBKA4",
#      "details": {
#        "dealReference": "6XQESB1EQAZKR1V2",
#        "actions": [
#          {
#            "actionType": "POSITION_OPENED",
#            "affectedDealId": "DIAAAAFVEFBBKA4"
#          }
#        ],
#        "marketName": "Fuller Smith & Turner",
#        "goodTillDate": null,
#        "currency": "GBP",
#        "size": 2,
#        "direction": "BUY",
#        "level": 779.9,
#        "stopLevel": null,
#        "stopDistance": null,
#        "guaranteedStop": false,
#        "trailingStopDistance": null,
#        "trailingStep": null,
#        "limitLevel": null,
#        "limitDistance": null
#      }
#    },
#    {
#      "date": "2020-11-16T17:17:29",
#      "epic": "UD.D.WIXUS.DAILY.IP",
#      "period": "DFB",
#      "dealId": "DIAAAAFU94TQRAR",
#      "channel": "WEB",
#      "type": "POSITION",
#      "status": "ACCEPTED",
#      "description": "Position opened: U94TQRAR",
#      "details": {
#        "dealReference": "6XQESB1EQ90XNSR2",
#        "actions": [
#          {
#            "actionType": "POSITION_OPENED",
#            "affectedDealId": "DIAAAAFU94TQRAR"
#          }
#        ],
#        "marketName": "Wix.com Ltd",
#        "goodTillDate": null,
#        "currency": "GBP",
#        "size": 0.31,
#        "direction": "BUY",
#        "level": 24142,
#        "stopLevel": null,
#        "stopDistance": null,
#        "guaranteedStop": false,
#        "trailingStopDistance": null,
#        "trailingStep": null,
#        "limitLevel": null,
#        "limitDistance": null
#      }
#    },
#    {
#      "date": "2020-11-16T17:08:33",
#      "epic": "UD.D.ZMUS.DAILY.IP",
#      "period": "DFB",
#      "dealId": "DIAAAAFU924B7A3",
# etc.... 
##########################################################################
#

=head2 accounts - retrieve a list of accounts

 Parameters - none 

 Return value - Array ref containing hashes of accounts. 

=cut 
##########################################################################
sub accounts
{
   my ($self) = shift;

   my $headers =  {
                       'Content-Type' => 'application/json; charset=UTF-8',
                       'Accept' =>  'application/json; charset=UTF-8',
                       VERSION => 1,
                       CST=>$self->CST,
                       'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
                       'X-IG-API-KEY'=> $self->apikey,
                   };
    #my $jheaders = encode_json($headers);
    my $jheaders=JSON->new->canonical->encode($headers);

    my $client = REST::Client->new();
    $client->setHost($self->_url);
    my $r=$client->GET ( '/accounts', $headers);

    my $resp=decode_json($client->responseContent());

    my $accounts=[];
    @$accounts=@{$resp->{accounts}};

    return $accounts;

}

# Typical return data: 
#[
# {"accountId":"...",
#  "status":"ENABLED",
#  "canTransferFrom":true,
#  "preferred":true,
#  "accountAlias":null,
#  "accountType":"SPREADBET",
#  "accountName":"Spread bet",
#  "balance":{
#              "deposit":89051.36,
#              "balance":152475.8,
#              "available":85942.65,
#              "profitLoss":22518.21
#             },
#   "canTransferTo":true,
#   "currency":"GBP"
# },
# {"accountId":"...",
#  "status":"ENABLED",
#  "canTransferFrom":true,
#  "preferred":false,
#  "accountAlias":null,
#  "accountType":"CFD",
#  "accountName":"CFD",
#  "balance":{
#               "available":0,
#               "profitLoss":0,
#               "balance":0,
#               "deposit":0
#            },
#  "canTransferTo":true,
#  "currency":"GBP"
#  }
#]
##########################################################################
#
# Return a ref to an array of positions. Each position is  
# a variable structure deep hash 
#
##########################################################################
sub positions
{
   my ($self) = shift;

   my $headers =    {
                       'Content-Type' => 'application/json; charset=UTF-8',
                       'Accept' =>  'application/json; charset=UTF-8',
                       VERSION => 2,
                       #   'IG-ACCOUNT-ID'=> $accountid, 
                       CST=>$self->CST,
                       'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
                       'X-IG-API-KEY'=> $self->apikey,
                    };
    #my $jheaders = encode_json($headers);
    my $jheaders=JSON->new->canonical->encode($headers);

 #   my $data =      {
 #                      encryptedPassword => "false",
 #                      identifier  => $self->username,
 #                      password  => $self->password
 #                   };
    my $client = REST::Client->new();
    $client->setHost($self->_url);
    #my $r;
#    $headers->{VERSION}=2;
    #$r=$client->GET (
    $client->GET (    '/positions',
                      $headers
                    );
    my $resp=decode_json($client->responseContent());

    my $positions=[];
    @$positions=@{$resp->{positions}};

    return $positions;
}
# example of the structure of a position
# Regeneron Pharmaceuticals Inc, 0.06
# {
#    "position" : {
#       "trailingStopDistance" : null,
#       "size" : 0.06,
#       "limitedRiskPremium" : null,
#       "stopLevel" : 50128,
#       "direction" : "BUY",
#       "level" : 50303,
#       "dealReference" : "6XQESB1E506WW334",
#       "controlledRisk" : false,
#       "currency" : "GBP",
#       "contractSize" : 1,
#       "createdDateUTC" : "2020-04-03T14:26:07",
#       "trailingStep" : null,
#       "createdDate" : "2020/04/03 15:26:07:000",
#       "limitLevel" : null,
#       "dealId" : "DIAAAAEL2T7AEAS"
#    },
#    "market" : {
#       "lotSize" : 1,
#       "marketStatus" : "EDITS_ONLY",
#       "instrumentType" : "SHARES",
#       "expiry" : "DFB",
#       "streamingPricesAvailable" : false,
#       "instrumentName" : "Regeneron Pharmaceuticals Inc",
#       "offer" : 60261,
#       "delayTime" : 0,
#       "updateTime" : "20:59:56",
#       "high" : 61455,
#       "percentageChange" : -2.01,
#       "netChange" : -1236,
#       "low" : 59886,
#       "bid" : 60261,
#       "updateTimeUTC" : "19:59:56",
#       "scalingFactor" : 1,
#       "epic" : "UC.D.REGN.DAILY.IP"
#    }
# }
#####################################################################
# Aggregate an array of positions into an array of unique 
# positions with 1 element per instrument, Items will be combined
# where more than one position is combined, in a field dependent way. 
# for exeample sizes will be added as will be profit
# a reference to an array is expected and a reference to a new array
# returned. 
#####################################################################

=head2 agg - aggregate positions into a flattened 1 element per instrument form. 

Parameters 

  1 Reference to an array of positions
  2 (Optional) Ref to an array of keys to sort on 

agg does three things actually. First, it joins together multiple positions of the same instrument, 
generating sensible values for things like profit/loss and size

Second, it performs some flattening of the deep structure for a position which comes from IG. 

Third it sorts the result. The default sort order I use is -profitpc instrumentName, but  
you can provide a 2rd parameter,  a reference to an array of items to sort by. 
Each item can optionally be preceeded by - to reverse the prder. If the first item equates equal, then 
the next item is used. 

=cut
#####################################################################
sub agg
{
  my ($self,$positions,$sortlist)=@_;
  my %totals;  # aggregated totals as arrays of individuals. 

  $self->flatten($positions, [qw/market position/]);
  for my $position (@$positions)
  {

   my $json = JSON->new;
#   $position->{size}= -abs($position->{size}) if ($position->{direction}//'' ne 'BUY'); 
   $position->{profit}=($self->fetch($position,'bid')-$self->fetch($position,'level'))*$self->fetch($position,'size');

   $position->{held}=Time::Piece->strptime($position->{createdDateUTC},"%Y-%m-%dT%H:%M:%S")  or die "strptime failed for ".$position->{createdDateOnly}; 
   $position->{held}=(gmtime()-$position->{held})/(24*3600); 

   my $ra=($totals{$position->{instrumentName}}||=[]);
   push(@$ra,$position);

  }

  # totals is a hash on instrument name each element is a pointer to an array of positions for the same instrument. 

  my $aggregated=[];
  for my $total (values %totals)
  {                                    # for one particular name 
     my $position={};                  # initialise the new aggregate position

     $position->{profit}=0;
     $position->{size}=0; 
     $position->{held}=0; 
     $position->{stopLevel}=[]; 
     $position->{createdDate}=[]; 
     $position->{createdDateUTC}=[]; 

     for my $subtotal ( @$total)         # go through all the positions for that one name
     {
      $position->{instrumentName}//=$subtotal->{instrumentName};
      $position->{size}+=$subtotal->{size};
      my $h; 
      $h=Time::Piece->strptime($subtotal->{createdDateUTC},"%Y-%m-%dT%H:%M:%S")  or die "strptime failed for ".$subtotal->{createdDateOnly}; 
      $h=(gmtime()-$h)/(24*3600); 
      $h=int($h*10)/10; 
      $subtotal->{held}=$h;
      $position->{held}+=$subtotal->{held}*$subtotal->{size}; # this is a size-weighted average. Needs division by total size.  
      $position->{bid}//=$subtotal->{bid};
      $position->{profit}+=$subtotal->{profit} ;
      $position->{epic}//=$subtotal->{epic};

      $position->{currency}//=$subtotal->{currency}; 
      $position->{marketStatus}//=$subtotal->{marketStatus}; 

      push(@{$position->{stopLevel}},$subtotal->{stopLevel}) if $subtotal->{stopLevel}; 
      push(@{$position->{createdDate}},$subtotal->{createdDate}); 
      push(@{$position->{createdDateUTC}},$subtotal->{createdDateUTC}); 
     }

     # now we have various housekeeping to do in some cases, eg where an average is calculated as a sum above, we divide by the number to get a true mean. 
     ###########

     $position->{held}=sprintf("%0.1f",$position->{held}/$position->{size});  $position->{held}.=" av" if (@$total>1); 


     $position->{level}=$position->{bid}-$position->{profit}/$position->{size}; # open level for multiple positions

     $position->{profitpc}=int(0.5+1000*$position->{profit}/($position->{level}*abs($position->{size})))/10 if ($position->{level}>0); 

     $position->{atrisk}=$position->{bid}*$position->{size};

     $position->{createdDate}=$self->sortrange($position->{createdDate}); 
     $position->{createdDateUTC}=$self->sortrange($position->{createdDateUTC}); 
     $position->{createdDateOnly}=$position->{createdDate}; 
     $position->{createdDateOnly}=~s/T[^-]+//g; 

     $position->{slpc}=join(',',map { $_?(int(1000.0*$_/$position->{bid})/10):''} @{$position->{stopLevel}});
     $position->{stopLevel}=join(',',@{$position->{stopLevel}}); 
     
     ########### 
     # end of aggregated operations 


     push(@$aggregated,$position);
   }

#  @$aggregated=sort { $b->{profitpc}<=>$a->{profitpc} }  @$aggregated;
   $sortlist//=[qw(-profitpc instrumentName)]; # default sort 
   $self->sorter($sortlist,$aggregated);
   return $aggregated;

}
# like agg, but do not do actual aggregation. 
# so we sort, add certain extra characteristics but thats all. 
##########################################################################
#

=head2 nonagg - like agg but do not do actual aggregation

Parameters 

  1 Reference to an array of positions
  2 (Optional) Ref to an array of keys to sort on 

 Return value - Array ref containing hashes of accounts. Should be the same size as the original. 

=cut 
##########################################################################
#sub nonagg
#{
#  my ($self,$positions,$sortlist)=@_;
#  my %totals;  # aggregated totals as arrays of individuals. 
#
#  $self->flatten($positions, [qw/market position/]);
#  for my $position (@$positions)
#  {
#
#   my $json = JSON->new;
#
#   $position->{profit}=($self->fetch($position,'bid')-$self->fetch($position,'level'))*$self->fetch($position,'size');
#   # create new profits element 
#
#     my $open=$position->{bid}-$position->{profit}/$position->{size};
#     $position->{level}=$open;
#     $position->{profitpc}=int(0.5+1000*$position->{profit}/($position->{level}*$position->{size}))/10;
#     $position->{atrisk}=$position->{bid}*$position->{size};
#     $position->{createdDateOnly}=$position->{createdDate};
#     $position->{createdDateOnly}=~s/ .*$//;
#   }
#
#   $sortlist//=[qw(-profitpc instrumentName)]; # default sort 
#   $self->sorter($sortlist,$positions);
#   return $positions;
#}
sub nonagg
{
  my ($self,$positions,$sortlist)=@_;
  my %totals;  # aggregated totals as arrays of individuals. 

  $self->flatten($positions, [qw/market position/]); 
  for my $position (@$positions)
  {

   my $json = JSON->new;

   $position->{size}=-abs($position->{size}) if ($position->{direction} eq 'SELL'); 
   $position->{profit}=($position->{bid}-$position->{level})*$position->{size};
   # create new profits element 

 #     my $open=$position->{bid}-$position->{profit}/$position->{size};
 #    $position->{level}=$open;
     $position->{profitpc}=int(0.5+1000*$position->{profit}/($position->{level}*abs($position->{size})))/10;
     $position->{atrisk}=$position->{bid}*$position->{size};
     $position->{createdDateOnly}=$position->{createdDate}; 
     $position->{createdDateOnly}=~s/ .*$//; 
     $position->{held}=Time::Piece->strptime($position->{createdDateUTC},"%Y-%m-%dT%H:%M:%S")  or die "strptime failed for ".$position->{createdDateOnly}; 
     $position->{held}=(gmtime()-$position->{held})/(24*3600); 
    $position->{held}=int($position->{held}*10+0.5)/10;  
     $position->{dailyp}=((1+$position->{profitpc}/100.0)**(1/$position->{held})-1)*100; 
    
   }

   $sortlist//=[qw(-profitpc instrumentName)]; # default sort 
   $self->sorter($sortlist,$positions); 
   return $positions;
}
####################################################################
# General array sort function. 
# Given an array of hash refs, and a sort key 
# considtying of an array of an array of keys to the hashes
# sort in place the array. 
# 
# sortkey, arrayref of keys. Sort order direction reversed 
# if key has - appended to start, eg -profitpc gives largest first 
# pos array eo be sorted, its an inplace sort. 
# uses the determinant $x eq $x+0 to determine if numeric or not. 
# improvements: may need to use a deep fetch to locate the items 
####################################################################

=head2 sorter - general array sort function for an array of hashes

Parameters 

  1 Ref to array of keys to sort. Each my be prefixed with a - to
    reverse the order on that key. If keys compare equal the next key is used. 
  2 Ref to an array of positions to sort. 

The array is sorted in-place. A numeric comparison is done if for 
both items $x == $x+0

Formatted datetimes are correctly sorted. 

=cut 
####################################################################
sub sorter
{
   my ($self,$sortkey,$pos)=@_;

   @$pos= sort {
                  my ($result)=0;
                  for my $fkey (@$sortkey)
                  {
                    my $key=$fkey;
                    my $dir=1;
                    $dir=-1 if ($key=~s/^-//);
                    # die "key=$key value=$b->{createdDateUTC} keys are ".join(', ',keys %$a); ; 
                    next if (!exists($a->{$key}) or !exists($b->{$key}));
                    my ($x1,$x2)=($a->{$key},$b->{$key});
                    map { s/[£%]//g } ($x1,$x2);

                    { no warnings qw(numeric);
                      my $warning;

                      if ($x1  eq  $x1+0 and $x2 eq $x2+0)
                      {
                          $result=$x1<=>$x2;
                      }
                      else
                      {   # note that this correctly handles a formatted date
                          $result=$x1 cmp $x2;
                      }
                    }
                    return $result*$dir if ($result);
                  }
                  return 0;
                }
                @$pos;

}
####################################################################
# The idea is this will close all the supplied positions, optionally returning a reference to 
# either/both an array of closed/non closed positions; 
# This is not quite working yet, needs more work, 
####################################################################

=head2 close  - close the supplied positions. 



Parameters 

  1 Ref to array of positions to close.  
    reverse the order on that key. 
  2/3 ref to done / notdone arrays to sort succesful / failed 
    closes in to. 

The idea is this will close all the supplied positions, optionally returning a reference to 


=head3 Status - very experimental. 

Contains die / print statements that you may wish to remove 

=cut 
####################################################################
sub close
{
   my $self=shift;
   my $positions=shift; # to close 
   my $done=shift;
   my $notdone=shift;

   my $verbose=0;

   my @done;
   my @notdone;

   my $headers =    {
                       'Content-Type' => 'application/json; charset=UTF-8',
                       'Accept' =>  'application/json; charset=UTF-8',
                       VERSION => 1,
                       #   'IG-ACCOUNT-ID'=> $accountid, 
                       CST=>$self->CST,
                       'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
                       'X-IG-API-KEY'=> $self->apikey,
                       '_method'=>'DELETE',
                    };

    my $data =      {
                       #encryptedPassword => "false",
                       #identifier  => $self->username,
                       #password  => $self->password
                       #direction => 'BUY', 
                       # epic=>
                       # expiry=> 
                       orderType=>'MARKET',
                       #size=>0.1 
                       ##guaranteedStop=>'false', 
                       forceOpen=>'true',
                       #timeInForce => "EXECUTE_AND_ELIMINATE", # "GOOD_TILL_CANCELLED"
                       timeInForce => "", # "GOOD_TILL_CANCELLED"
                    };
    my $client = REST::Client->new();

   $client->setHost($self->_url);


    my %existhash;
    map { $existhash{$self->fetch($_,'epic')}=$_ }   @$positions; # creat a hash on epic

for my $position (@$positions)
{
#    die dump($position); 

    my $existingsize=0;
    my $epic=$self->fetch($position,'epic');
    my $name=$self->fetch($position,'instrumentName');

    my $ms=$self->fetch($position,'marketStatus');

    if ($ms ne 'TRADEABLE')
    {
      push(@notdone,$position);
      print "$name, market status is $ms\n";
      next;
    }


    #$data->{epic}=$self->fetch($position,'epic'); 
    $data->{epic}=$epic;
    $data->{size}=$self->fetch($position,'size');
#    $data->{currencyCode}=$self->fetch($position,'currency');
    $data->{expiry}='DFB';
#    $data->{expiry}='-'; 
    $data->{direction}='SELL';

    #my $jdata = encode_json($data);
    my $jdata=JSON->new->canonical->encode($data);
    $client->PUT (
                      '/positions/otc',
                      $jdata,
                      $headers
                 );
     my $code=$client->responseCode();
     if ($code==200)
     {
        my $resp=decode_json($client->responseContent());
        my $dealReference=$resp->{dealReference};
        print "$name, dr=$dealReference\n";
        if (defined $dealReference  and length($dealReference)>5)
        {
           push(@done,$position);
           die;
           next;
           next;
        }
      }
      else
      {
        print "$name failed $code: ".$client->responseContent()."\n";
        push(@notdone,$position);
      }
}
      @$done=@done if ($done);
      @$notdone=@notdone if ($notdone);

printf "done=%d notdone=%d\n",0+@done,0+@notdone;
print "notdone:\n";

my $cpc='%%';
my $format="%-41sinstrumentName %+4.2fsize %-9.2flevel ".
           "%-8.2fbid £%-8.2fprofit %4.1fprofitpc%% £%10.2fatrisk %-9sstopLevel %-4sslpc$cpc\n";

$self->printpos("stdout" , ['Name','Size','Open','Latest','P/L','P/L%','Value','Stop','Stop'], $format);

map { $self->printpos("stdout" , $_, $format) } @notdone;

}
#####################################################################
# given a ref to an array of positions, attempt to buy the same 
# position in this object. 
# if the position already exists or is succesfully brought, count as success. 
# If the buy fails, include it in the returned list. 
# If all buys succesful then return an empty list. 
# done and notdone references may be supplied and if they are these should point to arrays 
# of the succesful and unsuccesful positions. 
# return value is NOT now used. 
# ignortradeable ... use this if the positionis an old one, so that tradeable status could 
#                    be out of date. 
#####################################################################

=head2 buy - attempt to buy a number of instruments. 

Parameters 

  1 Reference to an array of positions
  2 Optional ref to an array done, to be filled with succesful buys
  3 Optional ref to an array notdone, to be filled with the failed 
  4 ignore tradeable, one of the fields in a position relates to the market
    being open or closed (TRADEABLE) If this field is current, its a 
    good indication to skip this one (place it in the notdone array. 
    But if its out of date then setting this flag 1 attempts the trade 
    anyway. 

Attempt to buy positions. I have used this to move positions 
between a demo account and real account or vice-versa. 

=head3 Status - very experimental. 

Contains print statements that should 
probably be removed. 

=cut
#####################################################################
sub buy
{
   my $self=shift;
   my $positions=shift; # to buy
   my $done=shift;
   my $notdone=shift;
   my $ignoretradeable=shift;

   my $verbose=0;

   my @done;
   my @notdone;
   my $headers =    {
                       'Content-Type' => 'application/json; charset=UTF-8',
                       'Accept' =>  'application/json; charset=UTF-8',
                       VERSION => 2,
                       #   'IG-ACCOUNT-ID'=> $accountid, 
                       CST=>$self->CST,
                       'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
                       'X-IG-API-KEY'=> $self->apikey,
                    };

    my $data =      {
                       direction => 'BUY',
                       #epic=>
                       #size=>0.1 
                       orderType=>'MARKET',
                       guaranteedStop=>'false',
                       forceOpen=>'false',
                       timeInForce => "EXECUTE_AND_ELIMINATE", # "GOOD_TILL_CANCELLED"
                    };
    my $client = REST::Client->new();
    $client->setHost($self->_url);

    my $existing=$self->positions;
    my %existhash;
    map { $existhash{$self->fetch($_,'epic')}=$_ }   @$existing;

for my $position (@$positions)
{
#    die dump($position); 

    my $existingsize=0;
    my $epic=$self->fetch($position,'epic');
    my $name=$self->fetch($position,'instrumentName');

    my $ms=$self->fetch($position,'marketStatus');


    if (exists $existhash{$epic})
    {
     my $existingposition=$existhash{$epic};
     $existingsize=$self->fetch($existingposition,'size');
    }

    my $demandsize=$self->fetch($position,'size');
    my $wantedsize=$demandsize-$existingsize;

    print "existingsize=$existingsize wantedsize=$wantedsize, demandsize=$demandsize\n";
    if ($wantedsize<=0)
    {
      push(@done,$position);
      print "$name, not needed\n";
      next;
    }

    if ($ms ne 'TRADEABLE' and !$ignoretradeable)
    {
      push(@notdone,$position);
      print "$name, market status is $ms\n";
      next;
    }


    #$data->{epic}=$self->fetch($position,'epic'); 
    $data->{epic}=$epic;
    $data->{size}=$wantedsize;
    $data->{currencyCode}=$self->fetch($position,'currency');
    $data->{expiry}='DFB';

    #my $jdata = encode_json($data);
    my $jdata=JSON->new->canonical->encode($data);
    # die $jdata; 
    print "$data->{direction}: $position->{instrumentName} $position->{size}\n";
    $client->POST (
                      '/positions/otc',
                      $jdata,
                      $headers
                 );
     my $code=$client->responseCode();
     if ($code==200)
     {
      print "200: ".$client->responseContent()."\n";
        my $resp=decode_json($client->responseContent());
        my $dealReference=$resp->{dealReference};
        print "$name, dr=$dealReference\n";
        if (defined $dealReference  and length($dealReference)>5)
        {
           push(@done,$position);
           next;
        }
      }
      print "$name, failed code $code \n";
      push(@notdone,$position);
}
  @$done=@done if ($done);
  @$notdone=@notdone if ($notdone);
printf "done=%d notdone=%d\n",0+@done,0+@notdone;
print "notdone:\n";

return;

my $format="%-41sinstrumentName %+4.2fsize %-9.2flevel ".
           "%-8.2fbid £%-8.2fprofit %4.1fprofitpc%% £%10.2fatrisk\n";

$self->printpos("stdout" , ['Name','Size','Open','Latest','P/L','P/L%','Value','Stop','Stop'], $format);

map { $self->printpos("stdout" , $_, $format) } @notdone;

}


#####################################################################
# uses known structure of supplied deep hash to search for item
# should probably replace with a more generalised deep fetch function. 
#####################################################################

=head2 fetch

This function is a way to hide the various structures a position may have

Parameters 

   1 A position hash ref, $h  
   2 The name of the item to be retrieved. 

Returns undef if not found, or the value of item if it is. 

The function looks first in $h->{item} then 
in $h->{position}=>{item} and then in $h->{market}->{item} 

Its only useful with positions, not hashes in general. 

=cut 
#####################################################################
sub fetch
{
 my ($self,$position,$item)=@_;

  # return "NOT A HASREF $position"if (ref($position) ne 'HASH'); 
  die "supplied position $position to fetch() is not a HASHREF" if (ref($position) ne 'HASH');
  defined $item or die "fetch, item undefined";
  my $p=$position->{position};
  my $m=$position->{market};

     if (exists $position->{$item}) { return $position->{$item}; }
     elsif (exists $p->{$item}) { return $p->{$item}; }
     elsif (exists $m->{$item}) { return $m->{$item}; }
     else {
            return undef;
          }

}

#####################################################################
# given an instrument name in search, look for it inside the instrumentName, and return 
# the epic. Fail if result is not 1 item. 
# used for filling in the epic (a unique identifier) in old data files 
# where I forgot to store it. 
#####################################################################

=head2 epicsearch 

Find the epic (unique identifier) for an instrument from the underlying share. 

Parameters 

    1 A aubstring to be searched for in the name. 

This function calls IG's search API looking for a match to the name. If found 
the value of the epic is returned. 

=head3 Status - very experimental. 

Contains print and die statements. Useful if you forgot to record the epic. 

=cut 
#####################################################################
sub epicsearch
{
  my ($self,$search)=@_;
  my $headers =
  {
   'Content-Type' => 'application/json; charset=UTF-8',
   'Accept' =>  'application/json; charset=UTF-8',
    VERSION => 1,
    CST=>$self->CST,
    'X-SECURITY-TOKEN'=> $self->XSECURITYTOKEN,
    'X-IG-API-KEY'=> $self->apikey,
  };
  #my $jheaders = encode_json($headers);
  my $jheaders=JSON->new->canonical->encode($headers);
  my $client = REST::Client->new();
  $client->setHost($self->_url);
  $search=~s#/#%2F#g;
  my $url="/markets?searchTerm=$search";
  $search=~s#%2F#/#g;
  $url=~s/ /%20/g;
 my $r=$client->GET ( $url, $headers);

# my $resp=decode_json($client->responseContent()); 


  #print "url=$url\n"; 
  my $code;

  $code=$client->responseCode();

  my $retried=0;
  while ($code==403 and $retried<4)
  {
     sleep 10;
     $retried++;
     $r=$client->GET ( $url, $headers);
     $code=$client->responseCode();
#     print "search retried\n"; 
  }

  die "response code from  url='$url' code=$code retried $retried times" if ($code!=200);

  my $markets=decode_json($client->responseContent);
#   print JSON->new->ascii->pretty->encode($markets)."\n"; 

  my @wantedmarkets=grep { $_->{expiry} eq 'DFB' } @{$markets->{markets}};
    @wantedmarkets=grep { $self->_nothe($self->fetch($_,'instrumentName') , $search) } @wantedmarkets;

  @wantedmarkets=map { $_->{epic} } @wantedmarkets;
  die "Zero epics found for search $search" if (@wantedmarkets==0);
  die "Multiple epics found @wantedmarkets for search $search" if (@wantedmarkets!=1);

  return $wantedmarkets[0];

}
#####################################################
# remove a trailing 'the' 
#####################################################
sub _nothe
{
  my ($self,$x,$y)=@_;

  # print "comparing $x $y \n"; 
  $x=~s#/.*$##;
  $y=~s#/.*$##;

  return $x eq $y;
}
# so this is used to read one of my old data files. 
##################################################################################
# Reads am ascii file - older format and returns a list of positions, 
# a hashref keyed on epic. 
##################################################################################

=head2 readfile_oldformat 


Parameters

    1 Path to a file to read 

A file readable by this function may be generated by using printpos with  format as follows: 
           "%-41sinstrumentName %+6.2fsize %-9.2flevel ".
           "%-9.2fbid £%-8.2fprofit %5.1fprofitpc%% £%10.2fatrisk\n", 

This file was originally generated to be human readable so reading by machine is a stretch. 

=head3 Status - downright broken (for you). Sorry! 

May contains print and die statements. Contaions hardcoded paths that will need to be 
changed. 

=cut 
##################################################################################
sub readfile_oldformat
{
  my ($self, $f,$writenewfile)=@_;
  my $positions={};
  my $totalline;
  $f="/home/mark/igrec/results/$f";
  open(F,$f) or die "cannot open $f";
#Roku Inc                                   +0.38 16501.00   21842.0 £2029.58  32.4% £   8299.96
  my @fieldhashnames=qw(epic instrumentName size level bid profit profitpc atrisk);
  while (<F>)
  {
    my @fields;
    my @names=@fieldhashnames;
    my $position={};

    chomp;
    if (m/\|/)
    {
      die;
    }
    elsif (m/^Name/)
    {
      s/[£%]//g;
      @fields=split(/ +/);
      unshift(@fields,'Epic');
#      print "#".join("\|",@fields)."\n";
    }
    elsif (m/^Total/)
    {
      $totalline=$_;
    }
    else
    {
      my $name=substr($_,0,42);
      my $line=substr($_,43);
      $name=~s/ +$//;
      $line=~s/[\$£%]//g;
      @fields=split(/ +/,$line);
      my $epic=$self->epicsearch($name);
      unshift(@fields,$epic,$name);
      #die "$line\n@fields\n@names"; 
      while (@names)
      {
        $position->{shift(@names)}=shift(@fields);
      }
      $positions->{$epic}=$position;
    }
 }
 # close F; 
 if ($writenewfile)
 {
   $f=~s/results/r2/;
   if (! -e $f)
   {
     open(my $g,">" , $f) or die "Cannot open $f for write";
     my $format=    "%sepic|%sinstrumentName|%0.2fsize|%-0.2flevel|".
                    "%-0.2fbid|£%-0.2fprofit|%0.1fprofitpc%%|£%0.2fatrisk\n",
     print $g "Epic|Instrumentname|Size|Level|Bid|Profit£|Profitpc%|Atrisk£\n";
     my $a=$self->agg([values %$positions]);
     for (@$a)
     {
        $self->printpos($g,$_,$format);
     }
     print $g $totalline."\n";
   }
 }
 return $positions;
}
##################################################################################
# Reads am ascii file and returns a list of positions, 
# a hashref keyed on epic. 
##################################################################################

=head2 readfile


Parameters

    1 Path to a file to read 

A file readable by this function may be generated by using printpos with  format as follows: 
           "%sepic|%sinstrumentName|%0.2fsize|%-0.2flevel|".
           "%-0.2fbid|£%-0.2fprofit|%0.1fprofitpc%%|£%0.2fatrisk|%smarketStatus\n", 

=head3 Status - downright broken (for you). Sorry! 

The function contains a hardcoded path for reading the files.  You would need a 
crontab entry to generate them.   

May contain print and die statements. Contains hardcoded paths that will need to be 
changed. 

=cut 
##################################################################################
sub readfile
{
  my ($self,$f)=@_;

  my $positions={};
  $f="/home/mark/igrec/r2/$f";
  open(F,$f) or die "cannot open $f";
  my @fieldhashnames=qw(epic instrumentName size level bid profit profitpc atrisk tradeable);
  my $ln=0;
  while (<F>)
  {
    my @fields;
    my @names=@fieldhashnames;
    my $position={};

    $ln++;
    chomp;
    if (m/^Total/)
    {
      next;
    }
    elsif (m/ Positions$/)
    {
      next;
    }
    elsif (m/^ *$/)
    {
      next;
    }
    elsif (m/#/)
    {
      next;
    }
    elsif (!m/\|/)
    {
      die "No | lin line $ln file $f";
    }
    elsif (m/Epic/)
    {
      next;
    }
    else
    {
      s/[£&]//g;
      @fields=split(/\|/);
      for my $fieldname (@fieldhashnames)
      {
        die if (!defined $names[0]);
        #print "names[0]=$names[0]\n"; 
        $position->{$fieldname}=shift(@fields);
      }
      $positions->{$position->{epic}}=$position;
      $position->{marketStatus}//='';  # older files do not record this. 
    }
 }
 return $positions;
}
#####################################################################
# format strings contained embedded printf specifiers followed by 
# a hash element name . 
#
# eg "%sdate %sdescription %sepic %sstatus\n"; 
# eg "%-20sdate %-30sdescription %-20sepic %-15sstatus\n"; 
# eg 
#           "%sepic|%sinstrumentName|%6.2fsize|%-9.2flevel|".
#           "%-9.2fbid|£%-8.2fprofit|%5.1fprofitpc%%|£%10.2fatrisk\n", 
#eg 
#           "%-41sinstrumentName %+6.2fsize %-9.2flevel ".
#           "%-9.2fbid £%-8.2fprofit %5.1fprofitpc%% £%10.2fatrisk\n", 
# Arguments:
# 1) An IG object ref. (self) Is not really used. 
# 2) Either "stdout" or an open writable file handle. 
# 3) A hash possibly deep, with items. Ig the item is not found directly in the hash, 
# the $self->fetch function is used for access. If still not found
# then "UNDEF" is printed.
# CHANGED to $self->uds 
# OR: If this is an array ref, then a title line is ptinted using the format string 
#     and the referenced array of titles
# OR: If empty dtring ort undef, derive titles from the format 
#     string and print a title line.  
# 4) A formatting string. Can contain text, containing embedded 
#    format instructions like %6.2fsize here %6.2f is a print f 
#    specifier and size is the name of the item to retrieve from the hash. 
#  5,6)  up /down  can be percent gives green if > up, bold green if > 5*up. 
#        can be a coloration function of position. 
#        just one function, so no down ever. 
#        function takes argument position, and returns optional colors 
#####################################################################

=head2 printpos 

=head3 Parmeters

A file handle or the word stdout, all output sent here. 

A hashref  of items to print 
OR: If this is an array ref, then a title line is ptinted using the format string 
and the referenced array of titles
OR: If empty string or undef, derive titles from the format 
string and print a title line.  

A formatting string. Can contain text, containing embedded 
format instructions like %6.2fsize here %6.2f is a print f 
specifier and size is the name of the item to retrieve from the hash. 

OPTIONAL up     can be percent gives green if > up, bold green if > 5*up. 
can be a coloration function of position.  Just one function, so no down ever if a function is given 
function takes argument position, and returns optional colors 

OPTIONAL down   can be percent gives red if <down , bold red if < 5*down. 

=head3 Description

This is a very general function will work with any hash. 

=cut
#####################################################################
sub printpos
{

   my ($self,$out,$position,$format,$up,$down)=@_;

  my $colsub;

  $out=*STDOUT if ($out eq "stdout");

  $down=-$up if (defined $up and ref($up) eq '' and !defined $down) ;

  if (defined $up and  ref($up) ne 'CODE')
  {
    $colsub=sub 
        {
          my ($position)=shift;
          my $v1=$position->{dbid};
          my $col='';
          $v1=~s/%//;
          $col=Green if (defined $up and $v1>$up);
          $col=Red if (defined $down and $v1<$down);
          $col=Green+Bold if (defined $up and $v1>$up*5);
          $col=Red+Bold if (defined $down and $v1<5*$down);
          return $col;
        };
  }
  $colsub=$up if (defined $up and ref($up) eq 'CODE');
  $colsub=sub {''} if (!defined $up);


  my $titles=$format;
  if (ref($position) eq 'ARRAY') # its titles to print!
  {
     #$format=~s/%[-+]/%/g; 
     #print "$format\n"; 
     while ($format=~m/[-+]?([0-9]+)\.([0-9]+)/)
     {
       my $x;
       $x=$1;
       abs($2)>abs($x) and $x=$2;
       $format=~s/%([-+]?)([0-9]+)\.([0-9]+)/%$1$x/;
     }
     #print "#1 $format\n"; 
     $format=~s/%\+\+/%+/g;
     #print "#2 $format\n"; 
     $format=~s/%([-\+]?[0-9]+)\.[0-9]+/%$1/g;
     #print "#3 $format\n"; 
     $format=~s/%([-\+]?[0-9]+)[fd]/%$1s/g;
     #print "#4 $format\n"; 
     $format=~s/%([-\+]?[0-9]*)([a-zA-Z_][a-zA-Z0-9_]*)/%$1s/g;
     #die $format; 
     # print "$format\n"; exit; 
     #$"=":"; print "@$position\n"; 


     #$format="%-41s %+7s %11s %-10s £%-10s %5s%% £%12s %-9s %-4s"; 
     #print "$format\n"; #exit; 
    print $out Bold if ($self->col and defined $INC{'Term/Chrome.pm'});
    # print "format='$format' @$position\n"; 
    printf $out $format,@$position;
    print $out Reset if ($self->col and defined $INC{'Term/Chrome.pm'});
    return;
  }

  # auto generated title list from the names  
  if (!defined $position or $position eq '')
  {
    $titles=~s/\n//g;
    $titles=~s/%([-+0-9.]*)([sf])/%/g;
    $titles=~s/%%/__PC__/g;
    $titles=~s/%//; # just one 
    $titles=~s/£%([a-zA-Z]+)/%$1£/g;
    my @titles=split(/%/,$titles);
    map {s/[|,]//g } @titles;
    map {s/  +//g } @titles;
    map { s/__PC__//g; } @titles;
    map { s/([\w']+)/\u\L$1/g; } @titles;
    while ($format=~m/%[-+]?([0-9]+)\.([0-9]+)/)
     {
       my $x;
       #my $x=$1+$2; 
       $x=$1;
       $2>$x and $x=$2;
       $format=~s/%([-+]?)([0-9]+)\.([0-9]+)/%$1$x/;
     }
    $format=~s/(%[-+0-9.]*)[a-zA-Z]+/$1s/g;
    #$format=~s/(%[-+0-9]+)\.[0-9]+/$1/g; 
    $format=~s/£//g;
    #die "format=$format titles=@titles"; 
    print $out Bold  if ($self->col and defined $INC{'Term/Chrome.pm'});
    printf $out $format, @titles;
    print $out Reset if ($self->col and defined $INC{'Term/Chrome.pm'});
    return;
  }



#  $p=$position->{position};
#  $m=$position->{market};

  $format=~s/%%/##/g;


#  while (($format=~s/%([-+0-9]+\.[0-9]+)([a-z][a-zA-Z0-9]*)/%$1__S__/) || ($format=~s/%([-+0-9]*)([a-z][a-zA-Z0-9]*)/%$1__F__/))
#  { 
#     my $s; 
#     $s=$activity->{$2}; 
#     my $pos=$1; 
#     $pos=~s/-//; 
#     $s=substr($s,0,$pos) if (defined(pos) and $pos ne '' and $pos<length($s));
#     push(@args,$s); 
#  } 

  my $col='';
  while ($format=~s/%([-+0-9.]*[dsf])([a-zA-Z_][a-zA-Z0-9_]*)/%s/)
  {
     my $s;

     my $item=$2;
     my $len=$1//"";
#     die "item is UNDEF" if ($item eq 'UNDEF'); 
#     die "len is UNDEF" if ($len eq 'UNDEF'); 
#     $len='' if ($len eq 'UNDEF'); 
     $len="%".$len if ($len);
     if (defined $item and $item ne '' and exists $position->{$item} and defined $position->{$item})
     {
       $position->{$item}=~s/%//g;
       #$position->{$item}='0' if ($position->{$item} eq 'UNDEF'); 
       $s=sprintf($len,$position->{$item});
       if ($item eq 'dbid'  and exists $INC{'Term/Chrome.pm'} and $self->col)
       {
          ##my $v1=$position->{dbid}; 
          ##$v1=~s/%//; 
          ##$col=Green if (defined $up and $v1>$up); 
          ##$col=Red if (defined $down and $v1<$down); 
          ##$col=Green+Bold if (defined $up and $v1>$up*5); 
          ##$col=Red+Bold if (defined $down and $v1<5*$down); 

          # $col=&$colsub($position); 
       }
       # $col=Yellow if (defined $up); 
          # $col=&$colsub($position); 
     }
     elsif (defined $self->fetch($position,$item))
     {
       #$s=sprintf($len,$self->fetch($position,$2)//"UNDEF");
       $s=sprintf($len,$self->fetch($position,$item)//$self->uds);
       if ($item eq 'dbid'  and defined $INC{'Term/Chrome.pm'} and $self->col)
       {
          #my $v1; 

          #$v1=$self->fetch($position,'dbid'); 
          #$v1=~s/%//; 
          #$v1=100*$v1/$self->fetch($position,'bid'); 
          ###$col=Green if (defined $up and $self->col and $self->fetch($position,'dbid')/$self->fetch($position,'bid')>$up/100); 
          ###$col=Red if (defined $down and $self->col and $self->fetch($position,'dbid')/$self->fetch($position,'bid')<$down/100); 
          #$col=Green if (defined $up and $self->col and $v1>$up); 
          #$col=Red if (defined $down and $self->col and $v1<$down); 
          #$col=Green+Bold if (defined $up and $self->col and $v1>$up*5); 
          #$col=Red+Bold if (defined $down and $self->col and $v1<5*$down); 
          #$col=&$colsub($position); 
       }
          #$col=&$colsub($position); 

     }
     else
     {
       $len=~s/[df]/s/;
       $len=~s/\.[0-9]+//;
       #$s=sprintf($len,"UNDEF");
       $s=sprintf($len,$self->uds);
     }

          $col=&$colsub($position);
     $len=~s/[sf]$//;
     if ($len ne '') # len can be something like 0.2
     {
       $len=~s/%//;
       $len=abs($len) if ($len ne '');
       $s=substr($s,0,$len) if ($len and $len<length($s) and $len>=1);
     }

     $format=~s/%s/$s/;
  }

  $col=&$colsub($position)//'' if ($self->col and defined $INC{'Term/Chrome.pm'});
  $format=~s/##/%/g;
  $format=~s/£-/-£/g;
  print $out $col, $format;
  if (ref($col) ne '')
  { print $out Reset;
  }

}



=head2 sortrange 

=head3 Parameters
   
  Ref to an array containing dates in printed ascii format. 

If there are no dates or an empty array, an empty string is returned. 

If there is one date, then that date is returned

If there is more than one then the first and last after sorting is returned, with a dash between them. 

This is used in aggregation of positions and relates to creation dates with multiple positions
in the same security purchased at different times. 

=cut 

sub sortrange
{ 
   my ($self,$ar)=@_; 

   my @dates=sort @$ar; 
    
   return '' if (@dates==0); 
   return $dates[0] if (@dates==1); 
   return $dates[0] . "-".$dates[-1]; 
} 

=head1 DEPENDENCIES

 Moose
 Term::Chrom if available. 

=head1 UTILITIES

A more complete position lister is given as igdisp.pl

=head1 AUTHOR

Mark Winder, C<< <markwin at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-finance-ig at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Finance-IG>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Finance::IG


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Finance-IG>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/Finance-IG>

=item * Search CPAN

L<https://metacpan.org/release/Finance-IG>

=back


=head1 ACKNOWLEDGEMENTS

=head1 FURTHER READING

IG REST API Reference https://labs.ig.com/rest-trading-api-reference

=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2020 by Mark Winder.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)


=cut

1; # End of Finance::IG
